home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PREVIEW / CLP2DLFI / DL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-10-29  |  74KB  |  2,394 lines
  1. Unit wdl;
  2.  
  3. Interface
  4.  
  5. Uses Classes, SysUtils, DBFserver, CommonCode, wPreview;
  6.  
  7.     const
  8.       TABWIDTH=2;
  9.         MAXCHK=70;
  10.         CHARLIST='abcdefghijklmnopqrstuvwxyz0123456789_()><=+, '+
  11.             'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  12.         DELIMLIST='()><=+, ';
  13.       LASTCHAR='abcdefghijklmnopqrstuvwxyz0123456789_'+
  14.             'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  15.  
  16.     type oDL=Class(TObject)
  17.     private
  18.         done,endline:boolean;
  19.         mxronly,runsilent,usemxr,valchk,wasmxr:boolean;
  20.         acnt,chgcnt,dcnt,ii10,ii7,ii8,ii9,indent,mxrcnt,pii:integer;
  21.         passlev,curline,subscnt,tparscnt,xcnt:integer;
  22.         acom,afterchk,comstr,errfile,errmess,line1,line2,org:string;
  23.         org2,tst,orgstr,orgtst,pc0,pc1,pc2,retstr,temp1,temp2,temp3:string;
  24.         tab,crlf,errport:string10;
  25.         curfunc:string20;
  26.         srcfile,destfile:string80;
  27.         hascase,hasdoproc,hasif,haswhile,hasfor,hasrepeat:integer;
  28.         hadget,hasuntil,simplecnt,latecnt,cmplxcnt,proccnt:integer;
  29.         inproc,hadsemi,hasdowith:boolean;
  30.         linecnt:integer;
  31.         mxlist:array [1..10] of string;
  32.         mxorg:array [1..10] of string;
  33.         dlist:array [1..15] of string135;
  34.         plist:array [1..30] of string135;
  35.         rlist:array [1..30] of string135;
  36.         equl:array [1..50] of string135;
  37.         saveline:array [1..6] of boolean;
  38.         ats:array [1..80] of integer;
  39.         tpars:array [1..80] of string135;
  40.         cmplx:array [1..MAXCHK,1..2] of string30;
  41.         late:array [1..MAXCHK,1..2] of string30;
  42.         simple:array [1..MAXCHK,1..2] of string30;
  43.         proc0arg:array [1..MAXCHK] of string30;
  44.         proc1arg:array [1..MAXCHK] of string30;
  45.         proc2arg:array [1..MAXCHK] of string30;
  46.         proctest:array [1..MAXCHK] of string30;
  47.         inlines,outlines,flist,xarr:tstringlist;
  48.         defines,prvlist,publist:tstringlist;
  49.         out:lpr;
  50.         fields:oDB;
  51.         function  argchk(orgstr,srchfor,has0arg,
  52.          has1arg,has2arg:string):string;
  53.         function  chkline(wasmxr:boolean):boolean;
  54.         function  fixline:boolean;
  55.         function  fldconv(orgstr:string):string;
  56.         function  mdxconv:boolean;
  57.         function  getline(var aStr:string):boolean;
  58.         procedure AddCmplx(s1,s2:string);
  59.         procedure AddLate(s1,s2:string);
  60.         procedure AddSimple(s1,s2:string);
  61.         procedure cnvrt(passlev:integer);
  62.         procedure convmxr(var astr:string;var waschg:boolean);
  63.         procedure delfi2(subnum:integer;themodule,aline:string);
  64.         procedure delphiconv;
  65.         procedure putline(aStr:string);
  66.         procedure initarrs(fordbw:boolean);  { INITARRS }
  67.         procedure loadflds(dpath:string);
  68.         procedure nuline(orgstr,line1,line2:string;
  69.          var equallist:array of string135;var ecnt:integer);
  70.         procedure savevar(mn,cn,vn,xn,fn,dn:string);
  71.         procedure AddProc(ftest,a0,a1,a2:string);
  72.         procedure CleanUpDelphi;
  73.         function  CapFirstChar(aStr:string):string;
  74.         procedure SaveOther(srcf:string);
  75.         procedure ParsVars(srcf,ext:string;tStr:TStringlist);
  76.         procedure threepcs(var tindent:integer;
  77.          var tretstr,tacomment:string);
  78.     public
  79.       doDBWconv:boolean;
  80.       constructor Create;
  81.       procedure Free;
  82.       procedure dbase2delphi(curdir,srcf:string);
  83.     end;
  84.  
  85. Implementation
  86.  
  87. uses NuDelphi;
  88.  
  89. constructor oDL.Create;
  90. begin
  91.   fields:=nil;
  92.     dodbwconv:=true;
  93.   inlines:=TStringlist.Create;
  94.     outlines:=TStringlist.Create;
  95.     flist:=TStringlist.Create;
  96.     xarr:=TStringlist.Create;
  97.     prvlist:=TStringlist.Create;
  98.     publist:=TStringlist.Create;
  99.     defines:=TStringlist.Create;
  100. end;
  101.  
  102. procedure oDL.Free;
  103. begin
  104.   inlines.free;
  105.     outlines.free;
  106.     flist.free;
  107.     xarr.free;
  108.     prvlist.free;
  109.     publist.free;
  110.   defines.free;
  111. end;
  112.  
  113. procedure oDL.dbase2delphi(curdir,srcf:string);
  114. var ii:integer;
  115.     tt:tstringlist;
  116.         tt2:string;
  117. begin
  118.     dbUseExclusive(fields,InstalledTo+'\fields');
  119.     { load all field info, only do if no entries in file once }
  120.   if fields.RecCount=0 then begin
  121.     tt:=tstringlist.create;
  122.         tt.loadfromfile(InstalledTo+'\dbfdirs.txt');
  123.     MouseWait;
  124.         if tt.count>0 then begin
  125.             for ii:=0 to tt.count-1 do begin
  126.               tt2:=tt[ii];
  127.                 if not empty(tt2) then begin
  128.                     loadflds(tt2);
  129.                 end;
  130.             end;
  131.         end;
  132.     MouseGo;
  133.     tt.free;
  134.   End;
  135.   crlf:=chr(13)+chr(10);
  136.   comstr:='//';
  137.     outlines.clear;
  138.     publist.clear;
  139.     prvlist.clear;
  140.   defines.clear;
  141.   linecnt:=0;
  142.     { do dBaseWin conversion first }
  143.     srcfile:=noext(srcf)+'.prg';
  144.     destfile:=noext(srcf)+'.txt';
  145.     if dodbwconv then begin
  146.         inlines.LoadFromFile(curdir+'\'+srcfile);
  147.         mdxconv;
  148.         outlines.savetofile(curdir+'\'+destfile);
  149.     srcfile:=destfile; { set srcfile for Delphi conversion to use }
  150.     End;
  151.     { do Delphi conversion routine }
  152.     destfile:=noext(srcf)+'.pas';
  153.     outlines.clear;
  154.   linecnt:=0;
  155.     inlines.LoadFromFile(curdir+'\'+srcfile);
  156.     delphiconv;
  157.     cleanupdelphi;
  158.   db2dl.progress.caption:='Done With '+ltrim(str(outlines.count,5,0))+' Lines';
  159.   outlines.savetofile(curdir+'\'+destfile);
  160.     SaveOther(srcf);
  161.     dbClose(fields);
  162. end;
  163.  
  164. function oDL.CapFirstChar(aStr:string):string;
  165. var uu,ll:string;
  166. begin
  167.   uu:=upper(astr);
  168.   ll:=lower(astr);
  169.   result:=substr(uu,1,1)+substr(ll,2,100);
  170. end;
  171.  
  172. procedure oDL.CleanUpDelphi;
  173. var varsend,procindent,ii,jj,kk,mm,pcnt,p1:integer;
  174.     parms,uu,procname,proccom,tt2,p2,p3:string;
  175.         invar,inproc:boolean;
  176.         plist:array [1..300] of integer;
  177. begin
  178.   { add begin's, end's to procedure and functions }
  179.     { merge "param" line's into procedure heading }
  180.     pcnt:=0;
  181.     for ii:=0 to outlines.count-1 do begin
  182.       uu:=upper(outlines[ii]);
  183.         if (pin('PROCED',uu)) or (pin('FUNCT',uu)) then begin
  184.             procindent:=0;
  185.             procname:=outlines[ii];
  186.             proccom:='';
  187.             threepcs(procindent,procname,proccom);
  188.       mm:=pos(' ',procname);
  189.       if mm>0 then begin
  190.         tt2:=substr(procname,1,mm);
  191.                 if pin('FUNCT',uu) then tt2:=tt2+' ';
  192.             outlines[ii]:=space(procindent)+tt2+'o'+
  193.           CapFirstChar(noext(srcfile))+'.'+substr(procname,mm+1,130)+
  194.           proccom;
  195.       end;
  196.           if pcnt<300 then begin
  197.               pp(pcnt);
  198.                 plist[pcnt]:=ii;
  199.             end;
  200.         end;
  201.     end;
  202.     if pcnt>0 then begin  { terminate last proc }
  203.         pp(pcnt);
  204.         plist[pcnt]:=outlines.count-2;
  205.         { do in reverse order because we will be adding lines }
  206.         for ii:=(pcnt-1) downto 1 do begin
  207.           invar:=false;
  208.             kk:=plist[ii+1]-plist[ii];
  209.             if kk>20 then kk:=20;  { only check first 20 lines }
  210.             parms:='';
  211.             procindent:=0;
  212.             procname:=outlines[plist[ii]];
  213.             proccom:='';
  214.             threepcs(procindent,procname,proccom);
  215.             varsend:=plist[ii];
  216.             for jj:=plist[ii] to (plist[ii]+kk) do begin
  217.                 p1:=0;
  218.                 p2:=outlines[jj];
  219.                 p3:='';
  220.               threepcs(p1,p2,p3);
  221.                 uu:=upper(p2);
  222.                 if (pin('PARAM',uu)) then begin
  223.                   mm:=pos(' ',p2);
  224.                     tt2:='';
  225.                     if mm>0 then begin
  226.                       tt2:=substr(p2,mm+1,130);
  227.                       mm:=pos(';',tt2);
  228.                         if mm>0 then tt2:=substr(tt2,1,mm-1);
  229.                         tt2:=ltrim(trim(tt2));
  230.                     end;
  231.                     if not empty(tt2) then begin
  232.                       if empty(parms) then parms:=tt2
  233.                         else parms:=parms+','+tt2;
  234.                     end;
  235.           outlines[jj]:=space(procindent)+'{ parameters moved into header }';
  236.                 end;
  237.                 if (pin('LOCAL',uu)) then begin
  238.                   varsend:=jj;
  239.                   mm:=pos(' ',p2);
  240.                     tt2:='';
  241.                     if mm>0 then begin
  242.                       tt2:=substr(p2,mm+1,132);
  243.                         tt2:=ltrim(trim(tt2));
  244.                     end;
  245.                     if invar then begin
  246.                         outlines[jj]:=space(4)+tt2+p3;
  247.                     end else begin
  248.                         outlines[jj]:='Var '+tt2+p3;
  249.                     end;
  250.                   if not invar then invar:=true;
  251.                 end;
  252.             end;
  253.             if not empty(parms) then begin
  254.                 { knock off semi-colon on end before adding parameters }
  255.                 outlines[plist[ii]]:=space(procindent)+
  256.                   substr(procname,1,length(procname)-1)+'('+parms+');'+proccom;
  257.             end;
  258.             { add first "begin" of procedure block }
  259.       if empty(outlines[varsend+1]) then
  260.           outlines[varsend+1]:=space(procindent)+'Begin'
  261.       else outlines.insert(varsend+1,space(procindent)+'Begin');
  262.             { add final "end" of procedure block }
  263.             for kk:=(plist[ii+1]-1) downto (plist[ii]) do begin
  264.               if not empty(outlines[kk]) then begin
  265.                     outlines.insert(kk+1,space(procindent)+'End;');
  266.                     break;
  267.                 end;
  268.             end;
  269.         end;
  270.     end;
  271.   if defines.count>0 then begin
  272.     jj:=outlines.count-1;
  273.     if jj>20 then jj:=20;
  274.     for ii:=0 to jj do begin
  275.       p2:=outlines[ii];
  276.       threepcs(p1,p2,p3);
  277.       if p2='Type' then begin
  278.         outlines.insert(ii,'');
  279.         for kk:=defines.count-1 downto 0 do begin
  280.           tt2:=defines[kk];
  281.           tt2:=strtran(tt2,'#define','');
  282.           tt2:=ltrim(tt2);
  283.           tt2:=strtran(tt2,'"','''');
  284.           mm:=pos(' ',tt2);
  285.           if mm>0 then tt2[mm]:='=';
  286.             outlines.insert(ii,'  '+tt2+';');
  287.         end;
  288.         outlines.insert(ii,'');
  289.         outlines.insert(ii,'Const');
  290.         break;
  291.       end;
  292.     end;
  293.   end;
  294. end;
  295.  
  296. procedure oDL.ParsVars(srcf,ext:string;tStr:TStringlist);
  297. var tt:tstringlist;
  298.     tt2,p1,p2:string;
  299.         ii,jj,kk:integer;
  300. begin
  301.   tt:=tstringlist.create;
  302.     tt.sorted:=true;
  303.     tt.duplicates:=dupIgnore;
  304.   for ii:=0 to tstr.count-1 do begin
  305.       tt2:=tstr[ii];
  306.         tt2:=strtran(tt2,',',' '); { convert comma's to spaces }
  307.         split(tt2,' ',pars,parscnt);
  308.         for jj:=2 to parscnt do begin  { skip first word }
  309.           if not empty(pars[jj]) then begin
  310.               p1:=upper(pars[jj]);
  311.                 { skip declarations }
  312.                 if pin('PRIVATE',p1) then continue;
  313.                 if pin('PUBLIC',p1) then continue;
  314.                 if pin('DECLARE',p1) then continue;
  315.               kk:=pos('[',pars[jj]);
  316.               if kk>0 then begin
  317.                   p1:=substr(pars[jj],1,kk-1);
  318.                     p2:=substr(pars[jj],kk+1,100);
  319.           if (jj<parscnt) and (pin(substr(pars[jj+1],1,1),'0123456789'))
  320.           then begin
  321.             p2:=p2+',1..'+pars[jj+1];
  322.             pars[jj+1]:='';
  323.           end;
  324.           { put 'zzz' on front of arrays to force to end of list }
  325.                     pars[jj]:='zzz'+p1+':array [1..'+p2+' of integer;';
  326.                 end;
  327.               if not empty(pars[jj]) then tt.add(pars[jj]);
  328.             end;
  329.         end;
  330.     end;
  331.     tt.sorted:=false;
  332.   for ii:=0 to tt.count-1 do begin
  333.     if pin('array',tt[ii]) then tt[ii]:=substr(tt[ii],4,130);
  334.   end;
  335.     tt.insert(0,upper(noext(srcf)+'  '+ext));
  336.     tt.insert(1,'');
  337.     tstr.assign(tt);
  338.     tt.free;
  339. end;
  340.  
  341. procedure oDL.SaveOther(srcf:string);
  342. begin
  343.   if prvlist.count>0 then begin
  344.       ParsVars(srcf,'Private Variable''s',prvlist);
  345.       prvlist.savetofile(noext(srcf)+'.prv');
  346.     end;
  347.   if publist.count>0 then begin
  348.       ParsVars(srcf,'Public Variable''s',publist);
  349.       publist.savetofile(noext(srcf)+'.pub');
  350.     end;
  351. end;
  352.  
  353.  
  354. procedure oDL.delphiconv;
  355. var retstr,acomment:array [1..6] of string135;
  356.     indent:array [1..6] of integer;
  357.         ii,casecnt:integer;
  358.         p2,p3:string135;
  359.     tt,tst,ustr,orgstr:string;
  360.         removed,indocase,addbegin,hadsemi:boolean;
  361.         semistr:string10;
  362.         caseleft,p1,jj,kk,mm,lcnt,ll:integer;
  363. begin
  364.   { init buffer first }
  365.   curline:=1;
  366.   { start processing }
  367.     passlev:=1;
  368.   comstr:='//';
  369.   if passlev=1 then begin  { do simple conversions }
  370.     for ii:=1 to MAXCHK do begin
  371.       for jj:=1 to 2 do simple[ii][jj]:=' ';
  372.       for jj:=1 to 2 do late[ii][jj]:=' ';
  373.       for jj:=1 to 2 do late[ii][jj]:=' ';
  374.           proctest[ii]:=' ';
  375.             proc0arg[ii]:=' ';
  376.             proc1arg[ii]:=' ';
  377.             proc2arg[ii]:=' ';
  378.         end;
  379.     initarrs(False);
  380.     putline('Unit '+lower(noext(srcfile))+';');
  381.         putline('');
  382.         putline('Interface');
  383.         putline('');
  384.         putline('Type');
  385.         putline('');
  386.     putline(space(tabwidth)+'o'+CapFirstChar(noext(srcfile))+
  387.       '=Class(TObject)');
  388.     putline(space(tabwidth)+'Private');
  389.         putline('');
  390.     putline(space(tabwidth)+'Public');
  391.         putline('');
  392.     putline(space(tabwidth)+'End;');
  393.         putline('');
  394.     putline('Implementation');
  395.         putline('');
  396.     putline('Uses DBFserver, CommonCode, wPreview;');
  397.         putline('');
  398.     done:=False;
  399.     hascase:=0;
  400.     caseleft:=0;
  401.     casecnt:=0;
  402.     curfunc:='';  { used in DeleteFile() }
  403.     if dodbwconv then
  404.       db2dl.progress.caption:='Phase 3, Line '+str(curline,5,0)
  405.     else
  406.         db2dl.progress.caption:='Line '+str(curline,5,0);
  407.     While not done do begin
  408.           DoEvents2;
  409.       for ii:=1 to 6 do begin
  410.               indent[ii]:=0;
  411.                 retstr[ii]:='';
  412.                 acomment[ii]:='';
  413.                 saveline[ii]:=True;
  414.             end;
  415.       lcnt:=0;
  416.         { if a continued line must load all following related lines also }
  417.       for ii:=1 to 6 do begin
  418.           DoEvents2;
  419.         if getline(tst) then begin
  420.           retstr[ii]:=tst;
  421.           pp(curline);
  422.           if (curline mod 100)=0 then begin
  423.                     if dodbwconv then
  424.                       db2dl.progress.caption:='Phase 4, Line '+str(curline,5,0)
  425.                     else
  426.                         db2dl.progress.caption:='Line '+str(curline,5,0);
  427.           end;
  428.           p1:=indent[ii];
  429.           p2:=retstr[ii];
  430.           p3:=acomment[ii];
  431.           threepcs(p1,p2,p3);
  432.           indent[ii]:=p1;
  433.           retstr[ii]:=p2;
  434.           acomment[ii]:=p3;
  435.           pp(lcnt);
  436.           hadsemi:=(Copy(retstr[ii],length(retstr[ii]),1)=';');
  437.           if hadsemi then begin
  438.               { cut off ';' from end of line }
  439.             retstr[ii]:=Copy(retstr[ii],1,length(retstr[ii])-1);
  440.           End Else Begin
  441.             break;
  442.           End;
  443.         end else done:=true;
  444.       End;
  445.             if not empty(retstr[1]) then begin
  446.                 ustr:=upper(retstr[1]);
  447.                 ii:=pos('PRIVATE',ustr);
  448.                 if ii=0 then ii:=pos('DECLARE',ustr);
  449.                 if ii=1 then begin
  450.                   tt:='';
  451.                     for ll:=1 to lcnt do tt:=tt+' '+retstr[ll];
  452.                   prvlist.add(tt);
  453.                     continue;  { do not save line in code file }
  454.                 end else begin
  455.                     ii:=pos('PUBLIC',ustr);
  456.                     if ii=1 then begin
  457.                         tt:='';
  458.                         for ll:=1 to lcnt do tt:=tt+' '+retstr[ll];
  459.                         publist.add(tt);
  460.                         continue;  { do not save line in code file }
  461.           end else begin
  462.                         ii:=pos('#DEFINE',ustr);
  463.                         if ii=1 then begin
  464.               defines.add(retstr[1]);
  465.                             continue;  { do not save line in code file }
  466.             end;
  467.                     end;
  468.                 end;
  469.             end;
  470.       hasdoproc:=0;
  471.       hasif:=0;
  472.       haswhile:=0;
  473.       hasfor:=0;
  474.       hasrepeat:=0;
  475.       hasuntil:=0;
  476.       hasdowith:=False;
  477.       hascase:=0;
  478.       for ll:=1 to lcnt do begin
  479.           DoEvents2;
  480.           semistr:=';';
  481.         orgstr:=retstr[ll];
  482.         ustr:=upper(retstr[ll]);
  483.         ii:=pos(comstr,acomment[ll]);
  484.         if ii>0 then begin
  485.           acomment[ll]:=stuff(acomment[ll],ii,2,'{');
  486.           acomment[ll]:=acomment[ll]+' }';
  487.         End;
  488.         ii:=pos(';  {',acomment[ll]);
  489.         if ii>0 then begin
  490.           acomment[ll]:=stuff(acomment[ll],ii,2,'{');
  491.           acomment[ll]:=acomment[ll]+' }';
  492.         End;
  493.         addbegin:=False;
  494.           { do not append ";" to if's, while's, for's, repeat's }
  495.         if ll=1 then begin
  496.           hasdoproc:=pos('DO ',ustr);
  497.           hasif:=pos('IF ',ustr);
  498.           haswhile:=pos('DO WHILE ',ustr);
  499.           hasfor:=pos('FOR ',ustr);
  500.           hasrepeat:=pos('REPEAT',ustr);
  501.           hasuntil:=pos('UNTIL ',ustr);
  502.         End;
  503.         hasdowith:=False;
  504.         hascase:=pos('CASE',ustr);
  505.         if hascase>0 then begin
  506.           if pin('END',ustr) then begin
  507.             hascase:=0;
  508.             caseleft:=0;
  509.             casecnt:=0;
  510.             hascase:=0;
  511.             retstr[ll]:='End';
  512.             ustr:=upper(retstr[ll]);
  513.           End Else
  514.           Begin
  515.             if pos('DO',ustr)=1 then begin
  516.               hascase:=0;
  517.               caseleft:=indent[ll];
  518.               saveline[ll]:=False;
  519.             End Else
  520.             Begin
  521.               retstr[ll]:='if'+Copy(retstr[ll],5,100);
  522.               hasif:=1;
  523.               pp(casecnt);
  524.               ustr:=upper(retstr[ll]);
  525.             End;
  526.           End;
  527.         End;
  528.         if (hasif=1) Or (haswhile=1) Or (hasfor=1) Or (hasrepeat=1) then begin
  529.           semistr:='';
  530.         End;
  531.         if (hasif=1) Or (haswhile=1) then begin
  532.           addbegin:=True;
  533.         End;
  534.         if (hasif=1) And (ll=lcnt) then begin  { on last line, add "then" }
  535.           retstr[ll]:=retstr[ll]+' then';
  536.           ustr:=upper(retstr[ll]);
  537.         End;
  538.                 { on last line of "while", add "do" }
  539.         if (haswhile=1) And (ll=lcnt) then begin
  540.           retstr[ll]:=retstr[ll]+' do';
  541.           ustr:=upper(retstr[ll]);
  542.         End;
  543.                 { on last line of "for", add "do begin" }
  544.         if (hasfor=1) And (ll=lcnt) then begin  
  545.           retstr[ll]:=retstr[ll]+' do begin';
  546.           ustr:=upper(retstr[ll]);
  547.         End;
  548.         { convert 'set relation' to dbSetRelation }
  549.         if pos('SET RELATION',ustr)=1 then begin
  550.           split(retstr[ll],' ',pars,parscnt);
  551.           retstr[ll]:='dbf.SetRelation('+pars[6]+'.Area,'''+
  552.             pars[4]+''')';
  553.           ustr:=upper(retstr[ll]);
  554.         end;
  555.           { convert "=" to ":=", ignore for boolean }
  556.           { test expressions in if's, while's, until's, case's }
  557.         if (pin('=',retstr[ll])) And ((hasfor=1) Or
  558.                    (not ((hasif=1) Or (haswhile=1) Or (hasuntil=1) Or (hascase>0))))
  559.                      And (not pin(':=',retstr[ll])) then begin
  560.           split(retstr[ll],'=',pars,parscnt);
  561.           retstr[ll]:='';
  562.           for ii:=1 to parscnt do begin
  563.             retstr[ll]:=retstr[ll]+pars[ii];
  564.             if ii=1 then begin
  565.               retstr[ll]:=retstr[ll]+':=';
  566.             End Else
  567.             Begin
  568.               if ii<parscnt then begin
  569.                 retstr[ll]:=retstr[ll]+'=';
  570.               End;
  571.             End;
  572.           End;
  573.           ustr:=upper(retstr[ll]);
  574.         End;
  575.         ii:=pos('ELSE',ustr);
  576.         if ii=1 then begin
  577.           semistr:='';
  578.         End;
  579.         if ustr='ELSE' then begin
  580.           retstr[ll]:='End Else Begin';
  581.           ustr:=upper(retstr[ll]);
  582.         End;
  583.         if (hasdoproc=1) And (haswhile=0) then begin
  584.           if pin('WITH',ustr) then begin
  585.             hasdowith:=True;
  586.           End;
  587.           retstr[ll]:=Copy(retstr[ll],4,130);
  588.           ustr:=upper(retstr[ll]);
  589.         End;
  590.         if length(retstr[ll])=0 then begin
  591.           semistr:='';
  592.         End Else
  593.         Begin
  594.           { do simple conversions }
  595.           for ii:=1 to SimpleCnt do begin
  596.                   DoEvents2;
  597.               if pin(simple[ii,1],retstr[ll]) then begin
  598.               split(retstr[ll],simple[ii,1],pars,parscnt);
  599.                             retstr[ll]:=pars[1];
  600.                             for jj:=2 to parscnt do begin
  601.                               tt:=substr(pars[jj-1],length(pars[jj-1]),1);
  602.                                 if pin(tt,LASTCHAR) then begin
  603.                   if simple[ii,1]='"' then
  604.                                         retstr[ll]:=retstr[ll]+simple[ii,2]+pars[jj]
  605.                   else
  606.                                         retstr[ll]:=retstr[ll]+simple[ii,1]+pars[jj];
  607.                                 end else
  608.                                     retstr[ll]:=retstr[ll]+simple[ii,2]+pars[jj];
  609.                             end;
  610.             End;
  611.           End;
  612.           { do database command substitutions }
  613.           if pos('select',retstr[ll])=1 then begin
  614.             split(retstr[ll],' ',pars,parscnt);
  615.             for ii:=2 to parscnt do begin
  616.               if not empty(pars[ii]) then begin
  617.                 retstr[ll]:='dbSelect('+pars[ii]+')';
  618.                 break;
  619.               End;
  620.             End;
  621.           End;
  622.           for ii:=1 to ProcCnt do begin
  623.             retstr[ll]:=argchk(retstr[ll],proctest[ii],proc0arg[ii],
  624.               proc1arg[ii],proc2arg[ii]);
  625.           End;
  626.           ustr:=upper(retstr[ll]);
  627.             { convert field assignment statements }
  628.           retstr[ll]:=fldconv(retstr[ll]);
  629.         End;
  630.           { try to convert if's, while's, until's }
  631.         if (hasif>0) Or (haswhile>0) Or (hasuntil>0) then begin
  632.           split(retstr[ll],' And ',pars,parscnt);
  633.           if parscnt>1 then begin
  634.             for ii:=1 to MaxPars do tpars[ii]:='';
  635.             for ii:=1 to parscnt do begin
  636.               tpars[ii]:=pars[ii];
  637.             End;
  638.             tparscnt:=parscnt;
  639.             if tparscnt>0 then begin
  640.               for jj:=1 to tparscnt do begin
  641.                 split(tpars[jj],' Or ',pars,parscnt);
  642.                 if parscnt>1 then begin
  643.                   ii:=pos(' ',pars[1]);
  644.                   if ii>0 then begin
  645.                     pars[1]:=Copy(pars[1],1,ii)+'('+Copy(pars[1],ii+1,120);
  646.                   End Else
  647.                   Begin
  648.                     pars[1]:='('+pars[1];
  649.                   End;
  650.                   tpars[jj]:=unsplit(pars,') Or (',parscnt);
  651.                   if hasif>0 then begin
  652.                     ii:=pos('THEN',upper(tpars[jj]));
  653.                     if ii>0 then begin
  654.                       tpars[jj]:=Copy(tpars[jj],1,ii-2)+')'+
  655.                         Copy(tpars[jj],ii-1,120)
  656.                     End;
  657.                   End;
  658.                   if haswhile>0 then begin
  659.                     tpars[jj]:=tpars[jj]+')';
  660.                   End;
  661.                   if hasuntil>0 then begin
  662.                     tpars[jj]:=tpars[jj]+')';
  663.                   End;
  664.                 End;
  665.               End;
  666.             End;
  667.             parscnt:=tparscnt;
  668.             for ii:=1 to parscnt do begin
  669.               pars[ii]:=tpars[ii];
  670.             End;
  671.             ii:=pos(' ',pars[1]);
  672.             if ii>0 then begin
  673.               pars[1]:=Copy(pars[1],1,ii)+'('+Copy(pars[1],ii+1,120);
  674.             End Else
  675.             Begin
  676.               pars[1]:='('+pars[1];
  677.             End;
  678.             retstr[ll]:=unsplit(pars,') And (',parscnt);
  679.             if hasif>0 then begin
  680.               ii:=pos('THEN',upper(retstr[ll]));
  681.               if ii>0 then begin
  682.                 retstr[ll]:=Copy(retstr[ll],1,ii-2)+')'+
  683.                   Copy(retstr[ll],ii-1,120)
  684.               End;
  685.             End;
  686.             if haswhile>0 then begin
  687.               ii:=pos('DO BEGIN',upper(retstr[ll]));
  688.               if ii>0 then begin
  689.                 retstr[ll]:=Copy(retstr[ll],1,ii-2)+')'+
  690.                   Copy(retstr[ll],ii-1,120)
  691.               End;
  692.               retstr[ll]:=retstr[ll]+')';
  693.             End;
  694.             if hasuntil>0 then begin
  695.               retstr[ll]:=retstr[ll]+')';
  696.             End;
  697.           End Else
  698.           Begin
  699.             split(retstr[ll],' Or ',pars,parscnt);
  700.             if parscnt>1 then begin
  701.               ii:=pos(' ',pars[1]);
  702.               if ii>0 then begin
  703.                 pars[1]:=Copy(pars[1],1,ii)+'('+Copy(pars[1],ii+1,120);
  704.               End Else
  705.               Begin
  706.                 pars[1]:='('+pars[1];
  707.               End;
  708.               retstr[ll]:=unsplit(pars,') Or (',parscnt);
  709.               if hasif>0 then begin
  710.                 ii:=pos('THEN',upper(retstr[ll]));
  711.                 if ii>0 then begin
  712.                   retstr[ll]:=Copy(retstr[ll],1,ii-2)+')'+
  713.                     Copy(retstr[ll],ii-1,120)
  714.                 End;
  715.               End;
  716.               if haswhile>0 then begin
  717.                 retstr[ll]:=retstr[ll]+')';
  718.               End;
  719.               if hasuntil>0 then begin
  720.                 retstr[ll]:=retstr[ll]+')';
  721.               End;
  722.             End;
  723.           End;
  724.         End;
  725.           { correct conversion problem with "do while's" }
  726.         if pin(' do)',retstr[ll]) then begin
  727.           split(retstr[ll],' do)',pars,parscnt);
  728.           retstr[ll]:=unsplit(pars,') do',parscnt);
  729.         End;
  730.         ustr:=upper(retstr[ll]);
  731.         delfi2(ll,noext(srcfile),retstr[ll]);  { fill Vars.dbf with info  }
  732.                 { do some "late" simple changes }
  733.         for ii:=1 to LateCnt do begin
  734.               DoEvents2;
  735.             if pin(late[ii,1],retstr[ll]) then begin
  736.             split(retstr[ll],late[ii,1],pars,parscnt);
  737.             retstr[ll]:=unsplit(pars,late[ii,2],parscnt);
  738.             if ii=5 then begin  { special case "End Else Begin" }
  739.               semistr:='';
  740.             End;
  741.           End;
  742.         End;
  743.                 { fix "+;" and ",;" errors on continued lines }
  744.         if (ll<lcnt) and (length(retstr[ll])>0) then begin
  745.           tt:=Copy(retstr[ll],length(retstr[ll]),1);
  746.           if tt='+' then begin
  747.             semistr:='';
  748.           End;
  749.           if tt=',' then begin
  750.             semistr:='';
  751.           End;
  752.         End;
  753.         { no semi's on lines with only a comment }
  754.         if pos('{',retstr[ll])=1 then semistr:='';
  755.         { finish afill() conversion, ignore unknown dbf.XX( assign lines }
  756.         if pin('YY',retstr[ll]) then begin
  757.           ii:=pos(',',retstr[ll]);
  758.           if ii>1 then begin
  759.             split(retstr[ll],',',pars,parscnt);
  760.             retstr[ll]:=unsplit(pars,'[ii]:=',parscnt);
  761.             ii:=pos(')',retstr[ll]);
  762.             if ii>1 then begin
  763.               { if fill with param has ')', such as space(10), don't
  764.                 remove trailing ')' }
  765.               if pos('))',retstr[ll])=ii then
  766.                   retstr[ll]:=Copy(retstr[ll],1,ii)
  767.               else
  768.                   retstr[ll]:=Copy(retstr[ll],1,ii-1);
  769.             End;
  770.           End;
  771.         End;
  772.         if saveline[ll] then begin
  773.           if (caseleft>0) And (indent[ll]>caseleft) then begin
  774.             indent[ll]:=indent[ll]-TABWIDTH;
  775.           End;
  776.           hasif:=pos('IF ',ustr);
  777.           if (caseleft>0) And (casecnt>1) And (hasif=1) And
  778.                       (indent[ll]=caseleft) then begin
  779.             putline(space(indent[ll])+'End Else');
  780.           End;
  781.           if ((hasif=1) or (haswhile>0)) and pin(' $ ',retstr[ll]) then begin
  782.             { do simple conversions of 'aa $ bb' to pin(aa,bb) }
  783.             split(retstr[ll],' ',pars,parscnt);
  784.             jj:=0;
  785.             for ii:=1 to parscnt do begin
  786.               if pars[ii]='$' then begin
  787.                 if pin(' And ',retstr[ll]) or pin(' Or ',ustr) then
  788.                     pars[ii-1]:='pin'+pars[ii-1]+','+pars[ii+1]
  789.                 else
  790.                     pars[ii-1]:='pin('+pars[ii-1]+','+pars[ii+1]+')';
  791.                 jj:=ii;
  792.                 break;
  793.               end;
  794.             end;
  795.             if jj>0 then begin
  796.               kk:=jj-1;
  797.               for ii:=jj+2 to parscnt do begin
  798.                 pp(kk);
  799.                 pars[kk]:=pars[ii];
  800.               end;
  801.               parscnt:=kk;
  802.               retstr[ll]:=unsplit(pars,' ',parscnt);
  803.               retstr[ll]:=strtran(retstr[ll],') ''',' '')');
  804.             end;
  805.           end;
  806.           { convert 'go recnum' to 'dbf.go(recnum)' }
  807.           if pos('go ',retstr[ll])=1 then begin
  808.             retstr[ll]:='dbf.Go('+copy(retstr[ll],4,100)+')';
  809.           end;
  810.           if (addbegin) And (ll=lcnt) then begin
  811.             retstr[ll]:=retstr[ll]+' begin';
  812.           End;
  813.           if (hasdoproc=1) And (haswhile=0) then begin
  814.             if hasdowith then begin
  815.               split(retstr[ll],' with ',pars,parscnt);
  816.               retstr[ll]:=unsplit(pars,'(',parscnt);
  817.               retstr[ll]:=retstr[ll]+')';
  818.             End;
  819.           End;
  820.           ii:=pos('dbUse(',retstr[ll]);
  821.           if ii>0 then begin
  822.             split(retstr[ll],'''',pars,parscnt);
  823.             if parscnt=3 then begin
  824.                 retstr[ll]:=substr(retstr[ll],1,ii+5)+pars[2]+','+
  825.                   substr(retstr[ll],ii+6,100);
  826.             end;
  827.           end;
  828.                     if empty(retstr[ll]) then
  829.                         putline(space(indent[ll])+ltrim(acomment[ll]))
  830.                     else
  831.                         putline(space(indent[ll])+retstr[ll]+semistr+acomment[ll]);
  832.         End;
  833.       End;
  834.     End;
  835.         putline('');
  836.     putline('End.');
  837.   End;
  838. end;
  839.  
  840.  
  841. procedure oDL.delfi2(subnum:integer;themodule,aline:string);
  842. var vlist:array [1..8] of string20;
  843.     xtype:array [1..8] of string10;
  844.         ii,jj,kk,xcnt:integer;
  845.         ustr,tt,cn,vn:string135;
  846.         wasinarr:boolean;
  847. begin
  848.     { look for vars, fields, procedure and function declarations }
  849.   vlist[1]:='LOCAL ';
  850.   xtype[1]:='L';
  851.   vlist[2]:='PUBLIC ';
  852.   xtype[2]:='P';
  853.   vlist[3]:='PRIVATE ';
  854.   xtype[3]:='R';
  855.   vlist[4]:='STATIC ';
  856.   xtype[4]:='S';
  857.   vlist[5]:='FIELDS ';
  858.   xtype[5]:='F';
  859.   vlist[6]:='PARAM';
  860.   xtype[6]:='L';
  861.   vlist[7]:='FOR ';
  862.   xtype[7]:='4';
  863.   vlist[8]:='DECLARE ';
  864.   xtype[8]:='R';
  865.   xcnt:=8;
  866.   ustr:=upper(aline);
  867.   if empty(curfunc) then begin
  868.     curfunc:=themodule;
  869.   End;
  870.   kk:=pos('PROC ',ustr);
  871.   if kk>0 then begin
  872.     tt:=ltrim(Copy(aline,kk+5,100));
  873.     ii:=pos('(',tt);
  874.     if ii>0 then begin
  875.       tt:=upper(Copy(tt,1,ii-1));
  876.     End;
  877.     curfunc:=upper(tt);
  878.   End Else
  879.   Begin
  880.     jj:=pos('PROCEDURE',ustr);
  881.     if jj>0 then begin
  882.       tt:=ltrim(Copy(aline,jj+10,100));
  883.       ii:=pos('(',tt);
  884.       if ii>0 then begin
  885.         tt:=upper(Copy(tt,1,ii-1));
  886.       End;
  887.       curfunc:=upper(tt);
  888.     End;
  889.   End;
  890.   kk:=pos('FUNC ',ustr);
  891.   if kk>0 then begin
  892.     tt:=ltrim(Copy(aline,kk+5,100));
  893.     ii:=pos('(',tt);
  894.     if ii>0 then begin
  895.       tt:=upper(Copy(tt,1,ii-1));
  896.     End;
  897.     curfunc:=upper(tt);
  898.   End Else
  899.   Begin
  900.     jj:=pos('FUNCTION',ustr);
  901.     if jj>0 then begin
  902.       tt:=ltrim(Copy(aline,jj+9,100));
  903.       ii:=pos('(',tt);
  904.       if ii>0 then begin
  905.         tt:=upper(Copy(tt,1,ii-1));
  906.       End;
  907.       curfunc:=upper(tt);
  908.     End;
  909.   End;
  910.   wasinarr:=False;
  911.   cn:=padr(upper(curfunc),15);
  912.   for ii:=1 to xcnt do begin
  913.     DoEvents2;
  914.     kk:=pos(vlist[ii],ustr);
  915.     if kk=1 then begin
  916.       wasinarr:=True;
  917.         { saveline[subnum]=.f.  
  918.                 disgard var declaration lines after processing } 
  919.       kk:=pos(' ',aline);
  920.       if kk>0 then begin
  921.         aline:=Copy(aline,kk+1,100);
  922.       End;
  923.       split(aline,',',pars,parscnt);
  924.             { check for var array declaration of form aa[5,6] }
  925.       if parscnt>1 then begin
  926.         for jj:=1 to parscnt-1 do begin
  927.           if (pin('[',pars[jj])) And (not pin(']',pars[jj+1])) then begin
  928.             pars[jj]:=pars[jj]+','+pars[jj+1];
  929.             pars[jj+1]:='';
  930.           End;
  931.         End;
  932.       End;
  933.       for jj:=1 to parscnt do begin
  934.         kk:=pos('=',pars[jj]);
  935.         if kk>1 then begin
  936.           pars[jj]:=Copy(pars[jj],1,kk-1);
  937.         End;
  938.         savevar(themodule,cn,pars[jj],xtype[ii],' ',' ');
  939.       End;
  940.     End;
  941.   End;
  942.   if Not wasinarr then begin
  943.       { check vars in assignments, field replacements }
  944.     ii:=pos('=',aline);
  945.     if ii>0 then begin
  946.       tt:=Copy(aline,1,ii-1);
  947.       if pin('->',tt) then begin
  948.           { field assignment }
  949.         split(tt,'->',pars,parscnt);
  950.         savevar(themodule,cn,pars[2],'E',pars[1],' ');
  951.       End Else
  952.       Begin
  953.           { assign using ":=" }
  954.         savevar(themodule,cn,tt,'=',' ',' ');
  955.       End;
  956.     End Else
  957.     Begin
  958.       ii:=pos('REPL ',ustr);
  959.       jj:=pos('REPLACE ',ustr);
  960.       if (ii=1) Or (jj=1) then begin
  961.         split(aline,' ',pars,parscnt);
  962.         tt:=pars[2];
  963.         if pin('->',tt) then begin
  964.             { field assignment }
  965.           split(tt,'->',pars,parscnt);
  966.           savevar(themodule,cn,pars[2],'E',pars[1],' ');
  967.         End Else
  968.         Begin
  969.           savevar(themodule,cn,ltrim(pars[2]),'E',' ',' ');
  970.         End;
  971.       End;
  972.     End;
  973.   End;
  974. end;
  975.  
  976.  
  977. procedure oDL.savevar(mn,cn,vn,xn,fn,dn:string);
  978. var tn:string20;
  979. begin
  980.   tn:=padr(upper(ltrim(vn)),15);
  981.   { dbSelect(vars);
  982.   if Not dbf.Seek(tn+cn) then begin
  983.     vars.append;
  984.     vars.ss('prgname',mn);
  985.     vars.ss('funcname',cn);
  986.     vars.ss('uppername',tn);
  987.     vars.ss('actname',ltrim(vn));
  988.     vars.ss('src',xn);
  989.     vars.ss('fromdbf',upper(fn));
  990.     vars.ss('dbfpath',upper(dn));
  991.   End; }
  992. end;
  993.  
  994.  
  995. function oDL.mdxconv:boolean;
  996. var ii,jj,kk:integer;
  997. begin
  998.   mxronly:=false;  { only do mxr() conversion, no other syntax changes }
  999.   usemxr:=true;  { switch @ commands to use printing subsystem, mxr() }
  1000.   if (not pin('PRG',srcfile)) then begin
  1001.     srcfile:=trim(noext(srcfile))+'.PRG';
  1002.   End;
  1003.   errfile:=noext(srcfile)+'.FIX';  { errors output file }
  1004.   parscnt:=0;
  1005.   for ii:=1 to MaxPars do pars[ii]:='';
  1006.   { pass one }
  1007.   chgcnt:=0;  { keep track of number of lines actually changed }
  1008.   valchk:=False;  { during pass 1, check for any "valids", prepend lines to file }
  1009.   hadsemi:=False;  { check for lines with errors that span more than 1 line }
  1010.   ii7:=0;
  1011.   ii8:=0;
  1012.   ii9:=0;
  1013.   ii10:=0;
  1014.   for ii:=1 to MAXCHK do begin
  1015.     for jj:=1 to 2 do simple[ii][jj]:=' ';
  1016.     for jj:=1 to 2 do late[ii][jj]:=' ';
  1017.     for jj:=1 to 2 do cmplx[ii][jj]:=' ';
  1018.   End;
  1019.   initarrs(True);
  1020.   { pass 1, may add lines to the file }
  1021.   curline:=1;
  1022.   cnvrt(1);
  1023.     inlines.assign(outlines);
  1024.     outlines.clear;
  1025.   { pass 2, convert code }
  1026.   curline:=1;
  1027.   cnvrt(2);
  1028.   { DeleteFile(temp2);
  1029.   DeleteFile(temp3); }
  1030. end;
  1031.  
  1032.  
  1033. procedure oDL.cnvrt(passlev:integer);
  1034. var ii:integer;
  1035. begin
  1036.   retstr:='';
  1037.   indent:=0;
  1038.   acom:='';
  1039.   inproc:=True;
  1040.   endline:=False;
  1041.   tst:='';
  1042.   { init buffer first }
  1043.   { start processing }
  1044.     { find statics, locals, publics, privates, do mxr() conv. }
  1045.   if passlev=1 then begin
  1046.     linecnt:=0;
  1047.     curline:=1;
  1048.       db2dl.progress.caption:='Phase 1';
  1049.     While True do begin
  1050.       DoEvents2;
  1051.       if getline(tst) then begin
  1052.         pp(curline);
  1053.         wasmxr:=False;
  1054.         orgtst:=tst;  { in case we have to undo an mxr() conversion }
  1055.         chkline(wasmxr);
  1056.         afterchk:=tst;
  1057.         { convert @ say's to mxr() in first pass }
  1058.         if wasmxr then begin
  1059.           mxrcnt:=0;
  1060.           for ii:=1 to 10 do mxlist[ii]:=' ';
  1061.           for ii:=1 to 10 do mxorg[ii]:=' ';
  1062.           While True do begin
  1063.                   DoEvents2;
  1064.             if getline(tst) then begin
  1065.                             pp(curline);
  1066.                   if (curline mod 100)=0 then
  1067.                             db2dl.progress.caption:='Phase 1, Line '+str(curline,5,0);
  1068.               org2:=tst;
  1069.               indent:=0;
  1070.               acom:='';
  1071.               threepcs(indent,org2,acom);
  1072.               if (Copy(org2,length(org2),1)=';') And (mxrcnt<10) then begin
  1073.                                 pp(mxrcnt);
  1074.                 mxlist[mxrcnt]:=org2;
  1075.                 mxorg[mxrcnt]:=tst;
  1076.               End Else
  1077.               Begin
  1078.                                 pp(mxrcnt);
  1079.                 mxlist[mxrcnt]:=upper(org2);  { text only }
  1080.                 mxorg[mxrcnt]:=tst;  { full original line }
  1081.                 break;
  1082.               End;
  1083.             end else break;
  1084.           End;
  1085.           if (mxrcnt>0) then begin
  1086.             hadget:=0;
  1087.             for ii:=1 to mxrcnt do begin
  1088.               if pin('GET',mxlist[ii]) then begin
  1089.                 hadget:=ii;
  1090.                 break;
  1091.               End;
  1092.             End;
  1093.             if hadget>0 then begin
  1094.               { was "get" on one of the lines }
  1095.               { write "@ say" line #1, then the rest, no changes }
  1096.               putline(orgtst);
  1097.               for ii:=1 to mxrcnt do begin
  1098.                 putline(mxorg[ii]);
  1099.               End;
  1100.             End Else
  1101.             Begin
  1102.               { no "get", do mxr() conversion on multi-line text }
  1103.               { write "@ say" line #1, then the rest, no changes }
  1104.               putline(afterchk);
  1105.               if mxrcnt>1 then begin
  1106.                 for ii:=1 to mxrcnt-1 do begin
  1107.                   putline(mxorg[ii]);
  1108.                 End;
  1109.               End;
  1110.               { parse last line, add ")" to end }
  1111.               indent:=0;
  1112.               acom:='';
  1113.               org2:=mxorg[mxrcnt];
  1114.               threepcs(indent,org2,acom);
  1115.               org2:=org2+')';
  1116.               putline(space(indent)+org2+acom);
  1117.             End;
  1118.           End;
  1119.         end;
  1120.       End else break;  { no more lines }
  1121.     End;
  1122.   End;
  1123.   if passlev=2 then begin  { convert code }
  1124.     curline:=1;
  1125.     linecnt:=0;
  1126.       db2dl.progress.caption:='Phase 2';
  1127.     While True do begin
  1128.       DoEvents2;
  1129.       if getline(tst) then begin
  1130.         pp(curline);
  1131.         if (curline mod 100)=0 then
  1132.                 db2dl.progress.caption:='Phase 2, Line '+str(curline,5,0);
  1133.           fixline;
  1134.       end else break;
  1135.     End;
  1136.   End;
  1137. end;
  1138.  
  1139.  
  1140. procedure oDL.convmxr(var astr:string;var waschg:boolean);
  1141. var pc1,pc2,tt2,tt3:string135;
  1142.         jj,mm,kk,ii:integer;
  1143. begin
  1144.   if usemxr then begin
  1145.     { convert @ ?,? say ? to mxr(?,?,?) }
  1146.     pc1:=trim(upper(astr));
  1147.     hadsemi:=(Copy(astr,length(astr),1)=';');
  1148.     if (Copy(pc1,1,1)='@') And (Not (pin(' GET ',pc1))) And
  1149.             (pin('SAY',pc1)) then begin
  1150.       { check for @3,5 style, convert to @ 3,5 }
  1151.       if Copy(pc1,2,1)<>' ' then begin
  1152.         astr:='@ '+Copy(astr,2,120);
  1153.       End;
  1154.       { check for say" style, convert to say " }
  1155.       jj:=pos(' say"',astr);
  1156.       if jj>0 then begin
  1157.         astr:=Copy(astr,1,jj+3)+' '+Copy(astr,jj+4,120);
  1158.       End;
  1159.       jj:=pos(' say ',astr);
  1160.       kk:=pos(', ',astr);
  1161.       if (kk>0) And (kk<jj) then begin
  1162.         astr:=stuff(astr,kk,2,',');
  1163.       End;
  1164.       jj:=pos(' say ',astr);
  1165.       kk:=pos('  ',astr);
  1166.       if (kk>0) And (kk<jj) then begin
  1167.         astr:=stuff(astr,kk,2,' ');
  1168.       End;
  1169.       split(astr,' ',pars,parscnt);
  1170.       pc1:='';
  1171.       jj:=pos(' say ',astr);
  1172.       kk:=pos(' picture',astr);
  1173.       mm:=length(' picture');
  1174.       if kk=0 then begin
  1175.         kk:=pos(' pict',astr);
  1176.         mm:=length(' pict');
  1177.       End;
  1178.       tt3:=' ';
  1179.       if kk=0 then begin
  1180.         kk:=length(astr);
  1181.         tt2:=Copy(astr,jj+5,kk-(jj+5)+1);
  1182.       End Else
  1183.       Begin
  1184.         tt2:=Copy(astr,jj+5,kk-(jj+5)+1);
  1185.         tt3:=trim(Copy(astr,kk+mm,length(astr)));
  1186.       End;
  1187.       for ii:=1 to parscnt do begin
  1188.         pc2:=pars[ii];
  1189.         if Not empty(pars[ii]) then begin
  1190.           if pc2='@' then begin
  1191.             pc2:='prn.p(';
  1192.           End Else
  1193.           if pc2='say' then begin
  1194.             pc2:=',';
  1195.             if Not empty(tt3) then begin
  1196.               for jj:=ii+1 to parscnt do begin
  1197.                 pars[jj]:=' ';
  1198.               End;
  1199.               pars[ii+1]:='transform('+trim(tt2)+','+ltrim(trim(tt3))+')';
  1200.             End Else Begin
  1201.               for jj:=ii+1 to parscnt do begin
  1202.                 pars[jj]:=' ';
  1203.               End;
  1204.               pars[ii+1]:=trim(tt2);
  1205.             End;
  1206.           End;
  1207.           if ii<parscnt then begin
  1208.              pc1:=pc1+pc2;
  1209.           End;
  1210.         End;
  1211.       End;
  1212.       if Not hadsemi then begin
  1213.         { if not a continued line, then the conversion is complete }
  1214.         { leave waschg .f., so no further mxr() conversion will be done }
  1215.         pc1:=pc1+trim(pc2)+')';
  1216.       End Else
  1217.       Begin
  1218.         pc1:=pc1+trim(pc2);
  1219.         waschg:=True;
  1220.       End;
  1221.       astr:=pc1;
  1222.     End;
  1223.   End;
  1224. end;
  1225.  
  1226.  
  1227. function oDL.getline(var aStr:string):boolean;
  1228. begin
  1229.   if linecnt<inlines.count then begin
  1230.         aStr:=inlines[linecnt];
  1231.         pp(linecnt);
  1232.     result:=true;
  1233.     end else result:=false;
  1234. end;
  1235.  
  1236. procedure oDL.putline(aStr:string);
  1237. begin
  1238.     outlines.add(aStr);
  1239. end;
  1240.  
  1241. function oDL.chkline(wasmxr:boolean):boolean;
  1242. var ii:integer;
  1243.         tt:string135;
  1244. begin
  1245.   retstr:='';
  1246.   acom:='';
  1247.   indent:=0;
  1248.   line1:='';
  1249.   line2:='';
  1250.   for ii:=1 to 50 do equl[ii]:='';
  1251.   acnt:=0;
  1252.   if length(tst)>0 then begin
  1253.     retstr:=tst;
  1254.     threepcs(indent,retstr,acom);
  1255.     convmxr(retstr,wasmxr);
  1256.     tst:=retstr;
  1257.     line1:=tst;
  1258.     tt:=upper(tst);
  1259.     if pin('PUBLIC',tt) then begin
  1260.       nuline(tst,line1,line2,equl,acnt);
  1261.       valchk:=True;  { force prefix of defines to file }
  1262.     End Else
  1263.     if pin('PRIVATE',tt) then begin
  1264.       nuline(tst,line1,line2,equl,acnt);
  1265.     End Else
  1266.     if pin('LOCAL',tt) then begin
  1267.       nuline(tst,line1,line2,equl,acnt);
  1268.     End;
  1269.   End;
  1270.   if Not wasmxr then begin  { only save string if not an mxr() conversion }
  1271.     putline(space(indent)+line1+acom);
  1272.     if Not empty(line2) then begin
  1273.       putline(space(indent)+line2);
  1274.     End;
  1275.     if acnt>0 then begin
  1276.       for ii:=1 to acnt do begin
  1277.         putline(space(indent)+equl[ii]);
  1278.       End;
  1279.     End;
  1280.   End;
  1281.   Result:=True;
  1282. end;
  1283.  
  1284.  
  1285. function oDL.fixline:boolean;
  1286. var tt2,tt3,org2:string135;
  1287.         jj,ii,kk,mm:integer;
  1288.     bytag:boolean;
  1289. begin
  1290.   retstr:='';
  1291.   indent:=0;
  1292.   acom:='';
  1293.   if length(tst)>0 then begin
  1294.     orgstr:=tst;
  1295.     retstr:=orgstr;
  1296.     threepcs(indent,retstr,acom);
  1297.     org2:=retstr;
  1298.     if Not mxronly then begin
  1299.       { ++ option }
  1300.       if (pin('++',retstr)) And (Not (pin('+++',retstr))) then begin
  1301.         ii:=pos('++',retstr);
  1302.         if ii=1 then begin
  1303.           pc1:=Copy(retstr,ii+2,12);
  1304.           retstr:=pc1+'='+ltrim(pc1)+'+1';
  1305.         End;
  1306.         if ii=length(retstr)-1 then begin
  1307.           pc1:=Copy(retstr,1,ii-1);
  1308.           retstr:=pc1+'='+ltrim(pc1)+'+1';
  1309.         End;
  1310.       End;
  1311.       { -- option }
  1312.       if (pin('--',retstr)) And (Not (pin('---',retstr))) then begin
  1313.         ii:=pos('--',retstr);
  1314.         if ii=1 then begin
  1315.           pc1:=Copy(retstr,ii+2,12);
  1316.           retstr:=pc1+'='+ltrim(pc1)+'-1';
  1317.         End;
  1318.         if ii=length(retstr)-1 then begin
  1319.           pc1:=Copy(retstr,1,ii-1);
  1320.           retstr:=pc1+'='+ltrim(pc1)+'-1';
  1321.         End;
  1322.       End;
  1323.       { += option }
  1324.       if pin('+=',retstr) then begin
  1325.         split(retstr,'+',pars,parscnt);
  1326.         pc1:=pars[1];
  1327.         split(retstr,'=',pars,parscnt);
  1328.         pc2:=pars[2];
  1329.         retstr:=pc1+'='+ltrim(pc1)+'+('+pc2+')';
  1330.       End;
  1331.       { -= option }
  1332.       if pin('-=',retstr) then begin
  1333.         split(retstr,'-',pars,parscnt);
  1334.         pc1:=pars[1];
  1335.         split(retstr,'=',pars,parscnt);
  1336.         pc2:=pars[2];
  1337.         retstr:=pc1+'='+ltrim(pc1)+'-('+pc2+')';
  1338.       End;
  1339.       { *= option }
  1340.       if pin('*=',retstr) then begin
  1341.         split(retstr,'*',pars,parscnt);
  1342.         pc1:=pars[1];
  1343.         split(retstr,'=',pars,parscnt);
  1344.         pc2:=pars[2];
  1345.         retstr:=pc1+'='+ltrim(pc1)+'*('+pc2+')';
  1346.       End;
  1347.       { /= option }
  1348.       if pin('/=',retstr) then begin
  1349.         split(retstr,'/',pars,parscnt);
  1350.         pc1:=pars[1];
  1351.         split(retstr,'=',pars,parscnt);
  1352.         pc2:=pars[2];
  1353.         retstr:=pc1+'='+ltrim(pc1)+'/('+pc2+')';
  1354.       End;
  1355.     End;
  1356.     for ii:=1 to SimpleCnt do begin
  1357.       DoEvents2;
  1358.       if Not empty(simple[ii,1]) then begin
  1359.         if (ii=ii7) And (pin('pict',retstr)) then begin
  1360.           continue;
  1361.         End;
  1362.         if (ii=ii8) And (pin('mxprow',retstr)) then begin
  1363.           continue;
  1364.         End;
  1365.         if (ii=ii9) And (pin('mxpcol',retstr)) then begin
  1366.           continue;
  1367.         End;
  1368.         if (ii=ii10) And (pin('mxsetprc',retstr)) then begin
  1369.           continue;
  1370.         End;
  1371.         if (ii=13) And (pin('REQ',retstr)) then begin
  1372.           continue;
  1373.         End;
  1374.         jj:=pos(simple[ii,1],retstr);
  1375.         if (ii=ii7) And (jj>0) And (mxronly) then begin
  1376.           continue;
  1377.         End;
  1378.         While jj>0 do begin
  1379.               DoEvents2;
  1380.           pc1:='';
  1381.           pc2:='';
  1382.           if jj>1 then begin
  1383.             pc1:=Copy(retstr,1,jj-1);
  1384.             if length(retstr)>(jj-1+length(simple[ii,1])) then begin
  1385.               pc2:=Copy(retstr,jj+length(simple[ii,1]),120);
  1386.             End;
  1387.           End Else
  1388.           Begin
  1389.             pc2:=Copy(retstr,length(simple[ii,1])+1,120);
  1390.           End;
  1391.           retstr:=pc1+simple[ii,2]+pc2;
  1392.           jj:=pos(simple[ii,1],retstr);
  1393.           { if we know this can only occur once, just exit }
  1394.           if (ii=ii8) And (pin('mxprow',retstr)) then begin
  1395.             break;
  1396.           End;
  1397.           if (ii=ii9) And (pin('mxpcol',retstr)) then begin
  1398.             break;
  1399.           End;
  1400.           if (ii=ii10) And (pin('mxsetprc',retstr)) then begin
  1401.             break;
  1402.           End;
  1403.           if (ii=13) And (pin('REQ',retstr)) then begin
  1404.             break;
  1405.           End;
  1406.         End;
  1407.       End;
  1408.     End;
  1409.     if Not mxronly then begin
  1410.       if pin('SET ORDER',upper(retstr)) then begin
  1411.         bytag:=pin(' TAG',upper(retstr));
  1412.         split(retstr,' ',pars,parscnt);
  1413.         if not bytag then begin
  1414.           if parscnt=3 then begin
  1415.             retstr:='mxsetorder(0)';
  1416.           End Else
  1417.           if parscnt=4 then begin
  1418.             retstr:='mxsetorder('+pars[4]+')';
  1419.           End Else
  1420.           if parscnt=5 then begin
  1421.             if pin('"',pars[5]) or pin('''',pars[5]) then begin
  1422.               retstr:='mxtagorder('''+pars[5]+''')';
  1423.             End Else
  1424.               Begin
  1425.               retstr:='mxsetorder(0)';
  1426.             End;
  1427.           End;
  1428.         end else begin
  1429.           if parscnt=5 then begin
  1430.             if pin('"',pars[5]) or pin('''',pars[5]) then begin
  1431.               retstr:='mxtagorder('+pars[5]+')';
  1432.             End Else Begin
  1433.               retstr:='mxtagorder('''+pars[5]+''')';
  1434.             End;
  1435.           End else retstr:='mxtagorder('''')';
  1436.         end;
  1437.       End;
  1438.       jj:=pos('SEEK ',upper(retstr));
  1439.       if jj=1 then begin
  1440.         retstr:='mxseek('+substr(retstr,jj+5,120)+')';
  1441.       End;
  1442.       { now for more complicated stuff }
  1443.       if (pin(':=',retstr)) and (pin('->',retstr)) then begin
  1444.         split(retstr,':',pars,parscnt);
  1445.         pc1:=pars[1];
  1446.         orgstr:=ltrim(pc1);
  1447.         ii:=pos('=',retstr);
  1448.         pc2:=ltrim(Copy(retstr,ii+1,120));
  1449.         retstr:='replace '+orgstr+' with '+pc2
  1450.       End;
  1451.       if pin('(',retstr) then begin
  1452.         for jj:=1 to CmplxCnt do begin
  1453.               DoEvents2;
  1454.           if Not empty(cmplx[jj,1]) then begin
  1455.             split(retstr,' ',pars,parscnt);
  1456.             retstr:='';
  1457.             xarr.clear;
  1458.             for ii:=1 to parscnt do begin
  1459.               xarr.add(pars[ii]);
  1460.             End;
  1461.             xcnt:=parscnt;
  1462.             for ii:=1 to xcnt do begin
  1463.               if pin(cmplx[jj,1],xarr[ii-1]) then begin
  1464.                 split(xarr[ii-1],'-',pars,parscnt);
  1465.                 pc1:=pars[1];
  1466.                 if pin('()',xarr[ii-1]) then begin  { no param }
  1467.                   if jj=9 then begin
  1468.                     { for recno() }
  1469.                     split(xarr[ii-1],'(',pars,parscnt);
  1470.                     xarr[ii-1]:=pars[3];
  1471.                     split(xarr[ii-1],')',pars,parscnt);
  1472.                     pc2:=pars[1];
  1473.                     kk:=pos('=',pc1);
  1474.                     if kk>0 then begin
  1475.                       xarr[ii-1]:=Copy(pc1,1,kk)+cmplx[jj,2]+'('''+
  1476.                         Copy(pc1,kk+1,12)+''')'
  1477.                     End Else
  1478.                     Begin
  1479.                       xarr[ii-1]:=cmplx[jj,2]+'()';
  1480.                     End;
  1481.                   End Else
  1482.                   Begin
  1483.                     xarr[ii-1]:=cmplx[jj,2]+'()';
  1484.                   End;
  1485.                 End Else
  1486.                 Begin  { has a param }
  1487.                   { split(xarr[ii-1],"(",pars,parscnt) }
  1488.                   { xarr[ii-1]=pars[3] }
  1489.                   { split(xarr[ii-1],")",pars,parscnt) }
  1490.                   kk:=pos(cmplx[jj,1],xarr[ii-1])+length(cmplx[jj,1])+1;
  1491.                   pc2:=Copy(xarr[ii-1],kk,120);
  1492.                   pc2:=Copy(pc2,1,length(pc2)-2);  { knock off last )) }
  1493.                   xarr[ii-1]:=cmplx[jj,2]+'('+pc2+')';
  1494.                 End;
  1495.               End;
  1496.               if ii<xcnt then begin
  1497.                 retstr:=retstr+xarr[ii-1]+' ';
  1498.               End Else
  1499.               Begin
  1500.                 retstr:=retstr+xarr[ii-1];
  1501.               End;
  1502.             End;
  1503.           End;
  1504.         End;
  1505.       End;
  1506.     End;
  1507.     kk:=0;
  1508.     for ii:=1 to LateCnt do begin
  1509.       DoEvents2;
  1510.       if Not empty(late[ii,1]) then begin
  1511.         if (ii=7) And (pin('pict',retstr)) then begin
  1512.           continue;
  1513.         End;
  1514.         if (ii=10) And (pin('mxbof',retstr)) then begin
  1515.           continue;
  1516.         End;
  1517.         jj:=pos(late[ii,1],retstr);
  1518.         While (jj>0) And (jj>kk) do begin
  1519.               DoEvents2;
  1520.           pc1:='';
  1521.           pc2:='';
  1522.           if jj>1 then begin
  1523.             pc1:=Copy(retstr,1,jj-1);
  1524.             if length(retstr)>(jj-1+length(late[ii,1])) then begin
  1525.               pc2:=Copy(retstr,jj+length(late[ii,1]),120);
  1526.             End;
  1527.           End Else
  1528.           Begin
  1529.             pc2:=Copy(retstr,length(late[ii,1])+1,120);
  1530.           End;
  1531.           retstr:=pc1+late[ii,2]+pc2;
  1532.           kk:=jj+length(late[ii,2]);
  1533.           if ii=11 then begin  { special case for mxskip() }
  1534.             if pin(''''',)',retstr) then begin
  1535.               retstr:=pc1+'mxskip';
  1536.                             kk:=jj+length(late[ii,2]);
  1537.             End;
  1538.           End;
  1539.           jj:=pos(late[ii,1],retstr);
  1540.         End;
  1541.       End;
  1542.     End;
  1543.     pc1:=ltrim(upper(retstr));
  1544.     if Not mxronly then begin
  1545.       if pin('PROCEDU',pc1) then begin
  1546.         inproc:=True;
  1547.       End;
  1548.       if pin('FUNCTIO',pc1) then begin
  1549.         inproc:=False;
  1550.       End;
  1551.     End;
  1552.     { finally, check for hand changes and some final automatic }
  1553.     { changes }
  1554.     errmess:=' ';
  1555.     if 'DELETE'=trim(upper(retstr)) then begin
  1556.       retstr:='mxdelete()';
  1557.     End;
  1558.     if 'RECALL'=trim(upper(retstr)) then begin
  1559.       retstr:='mxrecall()';
  1560.     End;
  1561.     { convert "set message to ??" to mxppmes=?? }
  1562.     if pin('SET MESS',upper(retstr)) then begin
  1563.       split(retstr,' ',pars,parscnt);
  1564.       if parscnt=4 then begin
  1565.         retstr:='mxppmes='+pars[4]+'  '+comstr+
  1566.           ' ''set message to'' conversion';
  1567.       End;
  1568.     End;
  1569.     pc1:=ltrim(upper(retstr));
  1570.     { if last line had a semi-colon and an error, show next line }
  1571.     retstr:=trim(retstr);
  1572.     { scan for up to three continued lines }
  1573.     if Copy(retstr,length(retstr)-1,2)=';)' then begin
  1574.       retstr:=Copy(retstr,1,length(retstr)-1);
  1575.       endline:=True;
  1576.     End Else
  1577.     Begin
  1578.       if endline then begin
  1579.         retstr:=retstr+')';
  1580.         if Copy(retstr,length(retstr)-1,2)=';)' then begin
  1581.           retstr:=Copy(retstr,1,length(retstr)-1);
  1582.           endline:=True;
  1583.         End Else
  1584.         Begin
  1585.           endline:=False;
  1586.         End;
  1587.       End;
  1588.     End;
  1589.     if Copy(retstr,length(retstr),1)=';' then begin
  1590.       if Not empty(errmess) then begin
  1591.         hadsemi:=True;
  1592.       End;
  1593.     End Else
  1594.     Begin
  1595.       hadsemi:=False;
  1596.     End;
  1597.     if org2<>retstr then begin
  1598.             pp(chgcnt);
  1599.     End;
  1600.     if empty(retstr) then putline(space(indent)+acom)
  1601.     else putline(space(indent)+retstr+'  '+acom);
  1602.   End Else
  1603.   Begin
  1604.     putline('');
  1605.   End;
  1606.   Result:=True;
  1607. end;
  1608.  
  1609.  
  1610. procedure oDL.nuline(orgstr,line1,line2:string;
  1611.   var equallist:array of string135;var ecnt:integer);
  1612. var jj,pcnt,ii,rcnt,kk,zz:integer;
  1613.     heading,orgvars,declist,tt:string135;
  1614.     assign:boolean;
  1615. begin
  1616.   tt:=upper(orgstr);
  1617.   assign:=False;
  1618.   if pin('LOCAL',tt) then begin
  1619.     assign:=True;
  1620.   End Else
  1621.   if pin('PRIVATE',tt) then begin
  1622.     assign:=True;
  1623.   End Else
  1624.   if pin('PUBLIC',tt) then begin
  1625.     assign:=True;
  1626.   End Else
  1627.   if pin('STATIC',tt) then begin
  1628.     assign:=True;
  1629.   End;
  1630.   if assign then begin
  1631.     jj:=pos(' ',orgstr);
  1632.     if jj>0 then begin
  1633.       { check for assignment in declaration line }
  1634.       { Clipper allows this using ":=", DBW doesn't }
  1635.       if pin('=',orgstr) then begin  { convert ":=" to "=" }
  1636.         for ii:=1 to 30 do begin
  1637.           zz:=pos('=',orgstr);
  1638.           if zz>0 then begin
  1639.             orgstr:=stuff(orgstr,zz,2,'=');
  1640.           End Else
  1641.           Begin
  1642.             break;
  1643.           End;
  1644.         End;
  1645.       End;
  1646.       heading:=Copy(orgstr,1,jj-1);
  1647.       orgvars:=Copy(orgstr,jj+1,120);
  1648.       declist:='';
  1649.       split(orgvars,',',pars,parscnt);
  1650.       pcnt:=0;
  1651.       rcnt:=0;
  1652.       for ii:=1 to 30 do plist[ii]:='';
  1653.       for ii:=1 to 30 do rlist[ii]:='';
  1654.       for kk:=1 to parscnt do begin
  1655.         if Not empty(pars[kk]) then begin
  1656.           if (not pin('[',pars[kk])) then begin
  1657.             { check for assignment in declaration line }
  1658.             zz:=pos('=',pars[kk]);
  1659.             if zz=0 then begin
  1660.                             pp(rcnt);
  1661.               rlist[rcnt]:=pars[kk];
  1662.             End Else
  1663.             Begin
  1664.                             pp(ecnt);
  1665.               equallist[ecnt-1]:=pars[kk];
  1666.               if pin('{}',equallist[ecnt-1]) then begin
  1667.                                 pp(pcnt);
  1668.                 plist[pcnt]:=Copy(pars[kk],1,zz-1)+'[0]';
  1669.                 equallist[ecnt-1]:='';
  1670.                 ecnt:=ecnt-1;
  1671.               End Else
  1672.               Begin
  1673.                                 pp(rcnt);
  1674.                 rlist[rcnt]:=Copy(pars[kk],1,zz-1);
  1675.               End;
  1676.             End;
  1677.           End Else
  1678.           Begin
  1679.                         pp(pcnt);
  1680.             plist[pcnt]:=pars[kk];
  1681.             if (not pin(']',pars[kk])) then begin
  1682.               plist[pcnt]:=pars[kk]+','+pars[kk+1];
  1683.               pars[kk+1]:='';
  1684.             End;
  1685.           End;
  1686.         End;
  1687.       End;
  1688.       orgvars:='';
  1689.       declist:='';
  1690.       if rcnt>0 then begin
  1691.         orgvars:=heading+' ';
  1692.         for kk:=1 to rcnt do begin
  1693.           orgvars:=orgvars+rlist[kk]+',';
  1694.         End;
  1695.         orgvars:=Copy(orgvars,1,length(orgvars)-1);
  1696.       End;
  1697.       if pcnt>0 then begin
  1698.         declist:='declare ';
  1699.         if (pin('STATIC',upper(heading))) Or (pin('PUBLIC',upper(heading))) then begin
  1700.           declist:='public ARR ';
  1701.         End;
  1702.         for kk:=1 to pcnt do begin
  1703.           declist:=declist+plist[kk]+',';
  1704.         End;
  1705.         declist:=Copy(declist,1,length(declist)-1);
  1706.       End;
  1707.     End;
  1708.     line1:=orgvars;
  1709.     if pcnt>0 then begin
  1710.       line2:=declist+'  '+comstr+' from '+heading;
  1711.     End;
  1712.   End;
  1713. end;
  1714.  
  1715. procedure oDL.AddSimple(s1,s2:string);
  1716. begin
  1717.   pp(SimpleCnt);
  1718.     simple[SimpleCnt,1]:=s1;
  1719.     simple[SimpleCnt,2]:=s2;
  1720. end;
  1721.  
  1722. procedure oDL.AddLate(s1,s2:string);
  1723. begin
  1724.   pp(LateCnt);
  1725.     late[LateCnt,1]:=s1;
  1726.     late[LateCnt,2]:=s2;
  1727. end;
  1728.  
  1729. procedure oDL.AddCmplx(s1,s2:string);
  1730. begin
  1731.   pp(CmplxCnt);
  1732.     cmplx[CmplxCnt,1]:=s1;
  1733.     cmplx[CmplxCnt,2]:=s2;
  1734. end;
  1735.  
  1736. procedure oDL.AddProc(ftest,a0,a1,a2:string);
  1737. begin
  1738.   pp(ProcCnt);
  1739.     proctest[ProcCnt]:=ftest;
  1740.     proc0arg[ProcCnt]:=a0;
  1741.     proc1arg[ProcCnt]:=a1;
  1742.     proc2arg[ProcCnt]:=a2;
  1743.     if empty(a1) then begin
  1744.         proc1arg[ProcCnt]:=a0;
  1745.     end;
  1746.     if empty(a2) then begin
  1747.         proc0arg[ProcCnt]:=a0;
  1748.     end;
  1749. end;
  1750.  
  1751. procedure oDL.initarrs(fordbw:boolean);  { INITARRS }
  1752. begin
  1753.   SimpleCnt:=0;
  1754.     LateCnt:=0;
  1755.     CmplxCnt:=0;
  1756.     ProcCnt:=0;
  1757.     if not fordbw then begin
  1758.     AddSimple('.t.','True');
  1759.     AddSimple('.f.','False');
  1760.     AddSimple('.not.','Not');
  1761.     AddSimple('.and.','And');
  1762.     AddSimple('.or.','Or');
  1763.     AddSimple('/*','{ ');
  1764.     AddSimple('*/',' }');
  1765.     AddSimple('endif','End');
  1766.     AddSimple('do while','While');
  1767.     AddSimple('"','''');
  1768.     AddSimple('otherwise','End Else Begin');
  1769.     AddSimple('delete','dbf.Delete');
  1770.     AddSimple('return ','Result:=');
  1771.     AddSimple('return','Exit');
  1772.     AddSimple('at(','pos(');
  1773.     AddSimple('date()','xDate');
  1774.     AddSimple('substr(','Copy(');
  1775.     AddSimple('exit','break');
  1776.     AddSimple('loop','continue');
  1777.     AddSimple('mxr(','prn.p(');
  1778.     AddSimple('mxrpwid(','prn.ReportWidth(');
  1779.     AddSimple('mxsetprc(','prn.SetRowCol(');
  1780.     AddSimple('fcrlf(','prn.CrLf(');
  1781.     AddSimple('mxreject()','prn.Eject');
  1782.     AddSimple('mxreject(False)','prn.Eject');
  1783.     AddSimple('mxpcol()','prn.pCol');
  1784.     AddSimple('mxprow()','prn.pRow');
  1785.     AddSimple('mxprset(','prn.PrSetMode(');
  1786.     AddSimple('useidx(','dbUse(');
  1787.     AddSimple('enddo','End');
  1788.     AddSimple('center(','padc(');
  1789.     AddSimple('len(','length(');
  1790.     AddSimple('afill(','for ii:=1 to YY do ');
  1791.     AddSimple('select()','dbf.Select(');
  1792.     AddSimple('specchars(','prn.SpecChars(');
  1793.     AddSimple('select (','dbSelectArea(');
  1794.     AddSimple('linespp','prn.PgLen');
  1795.     AddSimple('Page','prn.Page');
  1796.     AddSimple('next','End');
  1797.     AddSimple('procint(','ProcDbl(');
  1798.     AddSimple('swait(','OKbox(');
  1799.     AddSimple('laztray','prn.LazTray');
  1800.     AddSimple('lazline','prn.LazLine');
  1801.     AddSimple('lazbox','prn.LazBox');
  1802.     AddSimple('laztext','prn.LazText');
  1803.     AddSimple('lazinch','prn.LazInch');
  1804.     AddSimple('lazspecial','prn.LazSpecial');
  1805.     AddSimple('go top','dbf.GoTop');
  1806.     AddSimple('go bottom','dbf.GoBottom');
  1807.     AddSimple('iif(','iifi('); { convert iif( to iifi( }
  1808.         { these lines must come after any changes containing 'line/page' }
  1809.     AddSimple('line','prn.Line');
  1810.     AddSimple('page','prn.Page');
  1811.     AddLate('eof()','dbf.eof');
  1812.     AddLate('skip','dbf.skip');
  1813.     AddLate('recno()','dbf.Recno');
  1814.     AddLate('xaLock(ds, ,','dbf.aLock');
  1815.     AddLate('uztmpdbf(ds,','uztmpdbf(');
  1816.     AddLate('(ds,','(');
  1817.     AddLate('Lock(True)','Lock');
  1818.     AddLate('()','');
  1819.         { define function substitutions
  1820.             ~ after processing, result should have no parameters
  1821.             case is important when the search pattern is part of the result
  1822.             pattern, i.e. do not use 'pack' with change to pattern of 'dbpack'
  1823.             it will go into an infinite loop }
  1824.     AddProc('mxskip','dbf.Skip~','dbf.Skip~','dbf.Skip2');
  1825.     AddProc('mxappend','dbf.Append~','dbf.Append~','dbf.Append~');
  1826.     AddProc('mxbof','dbf.Bof~','dbf.Bof~','dbf.Bof~');
  1827.     AddProc('mxbottom','dbf.GoBottom~','dbf.GoBottom~','b.GoBottom~');
  1828.     AddProc('mxclose','dbf.Close~','dbf.Close~','dbf.Close~');
  1829.     AddProc('mxdbdel','dbf.Delete~','dbf.Delete~','dbf.Delete~');
  1830.     AddProc('mxdeld','dbf.Deleted~','dbf.Deleted~','dbf.Deleted~');
  1831.     AddProc('mxeof','dbf.Eof~','dbf.Eof~','dbf.Eof~');
  1832.     AddProc('mxgo','dbf.Go','dbf.Go','dbf.Go');
  1833.     AddProc('mxgoto','dbf.Go','dbf.Go','dbf.Go');
  1834.     AddProc('mxlock','dbf.Lock~','dbf.Lock~','dbf.Lock~');
  1835.     AddProc('mxalock','dbf.aLock~','dbf.aLock~','dbf.aLock~');
  1836.     AddProc('mxrecno','dbf.RecNo~','dbf.RecNo~','dbf.RecNo~');
  1837.     AddProc('mxseek','dbf.Seek','dbf.Seek','dbf.Seek');
  1838.         AddProc('mxsetorder','dbf.SetOrder','dbf.SetOrder','dbf.SetOrder');
  1839.         AddProc('mxtagorder','dbf.TagOrder','dbf.TagOrder','dbf.TagOrder');
  1840.     AddProc('mxtop','dbf.Top~','dbf.Top~','dbf.Top~');
  1841.     AddProc('mxunlock','dbf.unLock~','dbf.unLock~','dbf.unLock~');
  1842.     AddProc('lastrec','dbf.LastRec~','dbf.LastRec~','dbf.LastRec~');
  1843.     AddProc('pack','dbf.Pack~','dbf.Pack~','dbf.Pack~');
  1844.     AddProc('reccount','dbf.RecCount~','dbf.RecCount~','dbf.RecCount~');
  1845.     AddProc('mxrecall','dbf.Recall~','dbf.Recall~','dbf.Recall~');
  1846.     AddProc('zap','dbf.Zap~','dbf.Zap~','dbf.Zap~');
  1847.     AddProc('clozdbf','dbClose(ZZ)~','dbClose(ZZ)~','dbClose(ZZ)~');
  1848.     AddProc('clozall','dbf.CloseAll~','dbf.CloseAll~','dbf.CloseAll~');
  1849.     AddProc('loadtags','dbf.LoadTags~','dbf.LoadTags~','dbf.LoadTags~');
  1850.     AddProc('devtopr','prn.StartDoc(for8by11,forText,'''')~',
  1851.           'prn.StartDoc(for8by11,forText,'''')~',
  1852.             'prn.StartDoc(for8by11,forText,'''')~');
  1853.     AddProc('devtoscr','prn.StopDoc~','prn.StopDoc~','prn.StopDoc~');
  1854.     end else begin
  1855.     { simple substitions, done first }
  1856.     AddSimple('!=','<>');
  1857.     AddSimple('==','=');
  1858.     AddSimple('clear screen','clrscrn()');
  1859.     AddSimple('close all','clozall()');
  1860.     AddSimple('][',',');
  1861.     AddSimple('!','.not. ');
  1862.     ii7:=SimpleCnt;
  1863.     AddSimple('prow','mxprow');
  1864.     ii8:=SimpleCnt;
  1865.     AddSimple('pcol','mxpcol');
  1866.     ii9:=SimpleCnt;
  1867.         AddSimple('setprc','mxsetprc');
  1868.     ii10:=SimpleCnt;
  1869.     AddSimple('feject','mxreject');
  1870.     AddSimple('achoice','mxchoice');
  1871.         { simple substitions, done last }
  1872.       { unlockit first because lockit is subpart }
  1873.     AddLate('unlockit','mxunlock');
  1874.     AddLate('lockit','mxlock');
  1875.     AddLate('dbappend','mxappend');
  1876.     AddLate('append blank','mxappend()');
  1877.     AddLate('dbseek(','mxseek(');
  1878.     AddLate('dbsetorder(','mxsetorder(');
  1879.     AddLate('mxlock(.','mxlock(.');
  1880.     AddLate('dbdelete(','mxdbdel(');
  1881.     AddLate('deleted(','mxdeld(');
  1882.     AddLate('bof(','mxbof(');
  1883.         { see special case below, search for mxskip }
  1884.     AddLate('dbskip(','mxskip('',');
  1885.     AddLate('dbclosearea(','mxclose(');
  1886.     AddLate('dbgoto(','mxgoto(');
  1887.     AddLate('fieldname(','field(');
  1888.     AddLate('fcount(','mxfcount(');
  1889.     AddLate('dbrecall(','mxrecall(');
  1890.     { complex substitions of form emp->(dbappend()) }
  1891.     AddCmplx('unlockit','mxunlock');
  1892.     AddCmplx('lockit','mxlock');
  1893.     AddCmplx('dbappend','mxappend');
  1894.     AddCmplx('dbseek','mxseek');
  1895.     AddCmplx('clozdbf','mxclose');
  1896.     AddCmplx('dbsetorder','mxsetorder');
  1897.     AddCmplx('eof','mxeof');
  1898.     AddCmplx('dbskip','mxskip');
  1899.     AddCmplx('recno','mxrecno');
  1900.     AddCmplx('dbgobottom','mxbottom');
  1901.     AddCmplx('dbgotop','mxtop');
  1902.     AddCmplx('dbgoto','mxgoto');
  1903.     AddCmplx('dbdelete','mxdbdel');
  1904.     AddCmplx('deleted','mxdeld');
  1905.     AddCmplx('bof','mxbof');
  1906.     AddCmplx('rlock','mxlock');
  1907.     AddCmplx('dbclosearea','mxclose');
  1908.   end;
  1909. end;
  1910.  
  1911.  
  1912. procedure oDL.threepcs(var tindent:integer;
  1913.   var tretstr,tacomment:string);
  1914. var tt,nust,tt2:string;
  1915.     jj,ii,offset:integer;
  1916. begin
  1917.   tab:=chr(9);
  1918.   nust:='';
  1919.   if pin(tab,tretstr) then begin
  1920.     for ii:=1 to length(tretstr) do begin
  1921.       tt2:=Copy(tretstr,ii,1);
  1922.       if ord(tt2[1])=9 then begin  { tab key }
  1923.         tt2:=space(TABWIDTH);
  1924.       End;
  1925.       nust:=nust+tt2;
  1926.     End;
  1927.   End Else
  1928.   Begin
  1929.     nust:=tretstr;
  1930.   End;
  1931.   tretstr:=nust;
  1932.   tt:=ltrim(tretstr);
  1933.   tindent:=length(tretstr)-length(tt);
  1934.   tretstr:=tt;
  1935.   jj:=pos('//',tretstr);
  1936.   offset:=2;
  1937.   if jj>0 then begin
  1938.     tretstr:=Copy(tretstr,1,jj-1)+'  '+comstr+Copy(tretstr,jj+2,120);
  1939.   end else begin
  1940.       jj:=pos('&&',tretstr);
  1941.       if jj>0 then begin
  1942.         tretstr:=Copy(tretstr,1,jj-1)+'  '+comstr+Copy(tretstr,jj+2,120);
  1943.     end else begin
  1944.           jj:=pos('*',tretstr);
  1945.           if jj=1 then begin
  1946.             tretstr:=Copy(tretstr,1,jj-1)+'  '+comstr+Copy(tretstr,jj+1,120);
  1947.         offset:=1;
  1948.       end;
  1949.     end;
  1950.   End;
  1951.   { save the comment and clear it }
  1952.   tacomment:='';
  1953.   ii:=pos(comstr,tretstr);
  1954.   if ii=1 then begin
  1955.     tacomment:=tretstr;
  1956.     tretstr:='';
  1957.   End;
  1958.   if ii>1 then begin
  1959.     tacomment:='  '+comstr+Copy(tretstr,ii+offset,120);
  1960.     tretstr:=trim(Copy(tretstr,1,ii-1));
  1961.   End;
  1962.   tretstr:=trim(tretstr);
  1963. end;
  1964.  
  1965.  
  1966. procedure oDL.loadflds(dpath:string);
  1967. var dbfcnt,ii,jj:integer;
  1968.     dbflist:tstringlist;
  1969.     dbf:oDB;
  1970.     flds:DBFstruct;
  1971.     tt:string;
  1972. begin
  1973.   dbflist:=tstringlist.create;
  1974.   flds:=DBFstruct.create;
  1975.      LoadFileList(dpath,'*.DBF',dbflist);
  1976.   dbf:=nil;
  1977.   dbfcnt:=dbflist.count;
  1978.   if dbfcnt>0 then begin
  1979.     for ii:=0 to dbfcnt-1 do begin
  1980.       DoEvents2;
  1981.       tt:=dpath+'\'+noext(dbflist[ii]);
  1982.       dbUse(dbf,tt);
  1983.       dbf.GetDBFStruct(flds);
  1984.       dbClose(dbf);
  1985.       if flds.fcount>0 then begin
  1986.         for jj:=1 to flds.fcount do begin
  1987.           fields.append;
  1988.           with flds do begin
  1989.               fields.ss('fld',upper(fname[jj]));
  1990.               fields.ss('ftype',upper(ftype[jj]));
  1991.               fields.ii('flen',fwidth[jj]);
  1992.               fields.ii('fdec',fdecs[jj]);
  1993.               fields.ss('fromdbf',upper(noext(dbflist[ii])));
  1994.               fields.ss('path',upper(dpath));
  1995.           end;
  1996.         End;
  1997.       End;
  1998.     End;
  1999.   End;
  2000.   dbflist.free;
  2001.     flds.free;
  2002. end;
  2003.  
  2004.  
  2005. function oDL.fldconv(orgstr:string):string;
  2006. var ustr,res,tt,tt2,fldname,aliasname,repval:string135;
  2007.         tt3,ufld,ualias:string135;
  2008.     fndfld:boolean;
  2009.         parscnt2,withat,ii,jj,kk,mm:integer;
  2010.     pars2:array [1..MaxPars] of string135;
  2011. begin
  2012.   ustr:=upper(orgstr);
  2013.   res:=orgstr;
  2014.   fldname:='';
  2015.   aliasname:='';
  2016.   repval:='';
  2017.     { dBase style }
  2018.   if (pin('REPL ',ustr)) Or (pin('REPLACE ',ustr)) then begin
  2019.     split(ustr,' ',pars2,parscnt2);
  2020.     withat:=0;
  2021.     for ii:=1 to parscnt2 do begin
  2022.       if pars2[ii]='WITH' then begin
  2023.         withat:=ii;
  2024.         break;
  2025.       End;
  2026.     End;
  2027.         { split original string before building subsections }
  2028.     split(orgstr,' ',pars2,parscnt2);
  2029.     if withat>0 then begin
  2030.       tt:='';
  2031.       tt2:='';
  2032.       for ii:=2 to withat-1 do begin
  2033.         tt:=tt+pars2[ii];
  2034.       End;
  2035.       for ii:=withat+1 to parscnt2 do begin
  2036.         if ii<parscnt2 then begin
  2037.           repval:=repval+pars2[ii]+' ';
  2038.         End Else
  2039.         Begin
  2040.           repval:=repval+pars2[ii];
  2041.         End;
  2042.       End;
  2043.       repval:=fldconv(repval);
  2044.             { contains stuff between "replace" and "with" }
  2045.       if pin('->',tt) then begin
  2046.         split(tt,'->',pars2,parscnt2);
  2047.         aliasname:=pars2[1];
  2048.         fldname:=pars2[2];
  2049.       End Else
  2050.       Begin
  2051.         aliasname:='';
  2052.         fldname:=tt;
  2053.       End;
  2054.     End;
  2055.   End;
  2056.   if empty(fldname) then begin
  2057.       { look for Clipper style replacement:  cust->cust_no:="3533" }
  2058.     ii:=pos(':=',orgstr);
  2059.     jj:=pos('->',orgstr);
  2060.     if (ii>0) And (jj>0) And (jj<ii) then begin
  2061.       split(orgstr,':=',pars2,parscnt2);
  2062.       repval:=fldconv(pars2[2]);
  2063.       tt:=Copy(orgstr,1,ii-1);
  2064.       if pin('->',tt) then begin  { contains stuff between beginning of line and ":=" }
  2065.         split(tt,'->',pars2,parscnt2);
  2066.         aliasname:=pars2[1];
  2067.         fldname:=pars2[2];
  2068.       End Else
  2069.       Begin
  2070.         aliasname:='';
  2071.         fldname:=tt;
  2072.       End;
  2073.     End;
  2074.   End;
  2075.   if empty(fldname) then begin  { look for retrieval of field info rather than assignment }
  2076.     split(orgstr,'->',pars2,parscnt2);
  2077.     if parscnt2>1 then begin  { at least one field reference }
  2078.         { change "->" to "~~" to avoid infinite loop }
  2079.       orgstr:=unsplit(pars2,'~~',parscnt2);
  2080.       mm:=pos('~~',orgstr);
  2081.       jj:=0;
  2082.       kk:=0;
  2083.         { find the beginning and end of field reference }
  2084.       while mm>0 do begin
  2085.           DoEvents2;
  2086.         for ii:=mm-1 downto 1 do begin
  2087.           tt:=Copy(orgstr,ii,1);
  2088.           if pin(tt,CHARLIST) then begin
  2089.             jj:=ii;
  2090.             if pin(tt,DELIMLIST) then begin
  2091.               jj:=ii+1;
  2092.               break;
  2093.             End;
  2094.           End Else
  2095.           Begin
  2096.             break;
  2097.           End;
  2098.         End;
  2099.         for ii:=mm+2 to length(orgstr) do begin
  2100.           tt:=Copy(orgstr,ii,1);
  2101.           if pin(tt,CHARLIST) then begin
  2102.             kk:=ii;
  2103.             if pin(tt,DELIMLIST) then begin
  2104.               kk:=ii-1;
  2105.               break;
  2106.             End;
  2107.           End Else
  2108.           Begin
  2109.             break;
  2110.           End;
  2111.         End;
  2112.           { found start and finish? }
  2113.         if (jj>0) And (kk>0) then begin
  2114.           tt:='';
  2115.           if jj>1 then begin
  2116.             tt:=Copy(orgstr,1,jj-1);  { upto field info }
  2117.           End;
  2118.           tt2:='';
  2119.           if jj>1 then begin
  2120.             tt2:=Copy(orgstr,kk+1,100);  { after field info }
  2121.           End;
  2122.           tt3:=Copy(orgstr,jj,kk-jj+1);  { field reference }
  2123.           split(tt3,'~~',pars2,parscnt2);
  2124.           aliasname:=pars2[1];
  2125.           fldname:=pars2[2];
  2126.           ufld:=upper(padr(fldname,10));
  2127.           ualias:=upper(padr(aliasname,8));
  2128.           fndfld:=False;
  2129.           if fields.Seek(ufld+ualias) then begin
  2130.             fndfld:=True;
  2131.           End Else
  2132.           Begin
  2133.             if fields.Seek(ufld) then begin
  2134.               fndfld:=True;
  2135.             End;
  2136.           End;
  2137.           if fndfld then begin
  2138.             if fields.s('ftype')='N' then begin
  2139.                           if fields.i('flen')<7 then begin
  2140.                               if fields.i('fdec')>0 then
  2141.                                     tt3:=aliasname+'.f('''+fldname+''')'
  2142.                                 else
  2143.                                     tt3:=aliasname+'.f('''+fldname+''')';  { S/B .i( }
  2144.                             end else
  2145.                                 tt3:=aliasname+'.f('''+fldname+''')';
  2146.             End Else
  2147.             if fields.s('ftype')='L' then begin
  2148.               tt3:=aliasname+'.b('''+fldname+''')';
  2149.             End Else
  2150.             if fields.s('ftype')='D' then begin
  2151.               tt3:=aliasname+'.d('''+fldname+''')';
  2152.             End Else
  2153.             if fields.s('ftype')='C' then begin
  2154.               tt3:=aliasname+'.s('''+fldname+''')';
  2155.             End Else Begin
  2156.               tt3:=aliasname+'.X('''+fldname+''')';
  2157.             End;
  2158.           End Else
  2159.           Begin
  2160.             tt3:=aliasname+'.X('''+fldname+''')';
  2161.           End;
  2162.             { tie back together }
  2163.         End Else
  2164.         Begin
  2165.           tt:=Copy(orgstr,1,mm-1);  { upto field info }
  2166.           tt2:=Copy(orgstr,mm+2,140);  { after field info }
  2167.           tt3:='';
  2168.         End;
  2169.         orgstr:=tt+tt3+tt2;
  2170.         mm:=pos('~~',orgstr);
  2171.       End;
  2172.       res:=orgstr;
  2173.     End;
  2174.   End Else
  2175.   Begin
  2176.     tt:=upper(padr(fldname,10));
  2177.     tt2:=upper(padr(aliasname,8));
  2178.     if empty(tt2) then begin
  2179.       tt2:='';  { shorten search string to just "tt" }
  2180.     End;
  2181.       { if it doesn't find the field, it returns "dbX()" as the function }
  2182.       { where "X" will have to be changed to the correct method name by hand }
  2183.     fndfld:=False;
  2184.     if fields.Seek(tt+tt2) then begin
  2185.       fndfld:=True;
  2186.     End Else
  2187.     Begin
  2188.       if fields.Seek(tt) then begin
  2189.         fndfld:=True;
  2190.       End;
  2191.     End;
  2192.     if fndfld then begin
  2193.       if empty(aliasname) then begin
  2194.                 if fields.s('ftype')='N' then begin
  2195.                     if fields.i('flen')<7 then begin
  2196.                         if fields.i('fdec')>0 then
  2197.                             res:='dbf.ff('''+fldname+''','+repval+')'
  2198.                         else
  2199.                             res:='dbf.ff('''+fldname+''','+repval+')';  { S/B .ii( }
  2200.                     end else
  2201.                         res:='dbf.ff('''+fldname+''','+repval+')';
  2202.         End Else
  2203.         if fields.s('ftype')='L' then begin
  2204.           res:='dbf.bb('''+fldname+''','+repval+')';
  2205.         End Else
  2206.         if fields.s('ftype')='D' then begin
  2207.           res:='dbf.dd('''+fldname+''','+repval+')';
  2208.         End Else
  2209.         if fields.s('ftype')='C' then begin
  2210.           res:='dbf.ss('''+fldname+''','+repval+')';
  2211.         End Else Begin
  2212.           res:='dbf.XX('''+fldname+''','+repval+')';
  2213.         End;
  2214.       End Else
  2215.       Begin
  2216.         if fields.s('ftype')='N' then begin
  2217.                     if fields.i('flen')<7 then begin
  2218.                         if fields.i('fdec')>0 then
  2219.                             res:=aliasname+'.ff('''+fldname+''','+repval+')'
  2220.                         else
  2221.                             res:=aliasname+'.ff('''+fldname+''','+repval+')';  { S/B .ii( }
  2222.                     end else
  2223.                         res:=aliasname+'.ff('''+fldname+''','+repval+')';
  2224.         End Else
  2225.         if fields.s('ftype')='L' then begin
  2226.           res:=aliasname+'.bb('''+fldname+''','+repval+')';
  2227.         End Else
  2228.         if fields.s('ftype')='D' then begin
  2229.           res:=aliasname+'.dd('''+fldname+''','+repval+')';
  2230.         End Else
  2231.         if fields.s('ftype')='C' then begin
  2232.           res:=aliasname+'.ss('''+fldname+''','+repval+')';
  2233.         End Else Begin
  2234.           res:=aliasname+'.XX('''+fldname+''','+repval+')';
  2235.         End;
  2236.       End;
  2237.     End Else
  2238.     Begin
  2239.       if empty(aliasname) then begin
  2240.                 res:='dbf.ss('''+fldname+''','+repval+')';
  2241.       End Else
  2242.       Begin
  2243.                 res:=aliasname+'.XX('''+fldname+''','+repval+')';
  2244.       End;
  2245.     End;
  2246.   End;
  2247.   Result:=res;
  2248. end;
  2249.  
  2250.  
  2251. function oDL.argchk(orgstr,srchfor,has0arg,
  2252.   has1arg,has2arg:string):string;
  2253.   { for all occurances in "orgstr" }
  2254.   { if "srchfor" found with 0 args, substitute "has0arg" }
  2255.   { if "srchfor" found with 1 args, substitute "has1arg" }
  2256.   { if "srchfor" found with 2 args, substitute "has2arg" }
  2257.   { if "srchfor" found with 3 args, substitute "has3arg" }
  2258. var starts,ennds,firstparen,lastparen,argsplit,ii,ll:integer;
  2259.     parencnt,argcnt,yy,zz:integer;
  2260.     upto,after,afterdot,targ1,targ2,dstt,tt3:string135;
  2261.         noparm0,noparm1,noparm2,hitparen,inarray:boolean;
  2262. begin
  2263.   noparm0:=False;
  2264.   noparm1:=False;
  2265.   noparm2:=False;
  2266.   ii:=pos('.',has0arg);
  2267.   afterdot:='';
  2268.   if ii>1 then begin
  2269.     afterdot:=Copy(has0arg,ii,30);
  2270.     ii:=pos('~',afterdot);
  2271.     if ii>1 then begin
  2272.       afterdot:=Copy(afterdot,1,ii-1);
  2273.     End;
  2274.   End;
  2275.   if pin('~',has0arg) then begin
  2276.     noparm0:=True;
  2277.     has0arg:=Copy(has0arg,1,length(has0arg)-1);
  2278.   End;
  2279.   if pin('~',has1arg) then begin
  2280.     noparm1:=True;
  2281.     has1arg:=Copy(has1arg,1,length(has1arg)-1);
  2282.   End;
  2283.   if pin('~',has2arg) then begin
  2284.     noparm2:=True;
  2285.     has2arg:=Copy(has2arg,1,length(has2arg)-1);
  2286.   End;
  2287.   starts:=pos(srchfor,orgstr);
  2288.   While starts>0 do begin
  2289.     DoEvents2;
  2290.     ennds:=0;
  2291.     firstparen:=0;
  2292.     lastparen:=0;
  2293.     argsplit:=0;
  2294.     parencnt:=0;
  2295.     ll:=length(orgstr);
  2296.     hitparen:=False;
  2297.     inarray:=False;
  2298.     for ii:=starts to ll do begin
  2299.       DoEvents2;
  2300.       if Copy(orgstr,ii,1)='(' then begin
  2301.         hitparen:=True;
  2302.         if firstparen=0 then begin
  2303.           firstparen:=ii;
  2304.         End;
  2305.         pp(parencnt);
  2306.       End;
  2307.       if Copy(orgstr,ii,1)='[' then begin
  2308.         inarray:=True;
  2309.       End;
  2310.       if Copy(orgstr,ii,1)=']' then begin
  2311.         inarray:=False;
  2312.       End;
  2313.       if (Not inarray) And (Copy(orgstr,ii,1)=',') then begin
  2314.         if argsplit=0 then begin
  2315.           argsplit:=ii;
  2316.         End;
  2317.       End;
  2318.       if Copy(orgstr,ii,1)=')' then begin
  2319.         parencnt:=parencnt-1;
  2320.         if (hitparen) And (parencnt=0) then begin
  2321.           lastparen:=ii;
  2322.           ennds:=ii;
  2323.           break;
  2324.         End;
  2325.       End;
  2326.     End;
  2327.       { pars string }
  2328.     upto:='';
  2329.     after:='';
  2330.     if starts>1 then begin
  2331.       upto:=Copy(orgstr,1,starts-1);
  2332.     End;
  2333.     if (ennds<ll) And (ennds>0) then begin
  2334.       after:=Copy(orgstr,ennds+1,ll);
  2335.     End;
  2336.     targ1:='';
  2337.     targ2:='';
  2338.       { get length of argument area }
  2339.     ii:=lastparen-firstparen-1;
  2340.     argcnt:=0;
  2341.     if ii>0 then begin
  2342.       if argsplit>0 then begin
  2343.         argcnt:=2;
  2344.           { has two arguments }
  2345.         targ1:=Copy(orgstr,firstparen+1,argsplit-firstparen-1);
  2346.         targ2:=Copy(orgstr,argsplit+1,lastparen-argsplit-1);
  2347.       End Else
  2348.       Begin
  2349.         argcnt:=1;
  2350.           { only one argument }
  2351.         targ1:=Copy(orgstr,firstparen+1,lastparen-firstparen-1);
  2352.       End;
  2353.     End;
  2354.       { change to new method for Delphi }
  2355.       { delete surrounding quote marks }
  2356.     yy:=pos('''',targ1);
  2357.     if yy>0 then begin
  2358.       targ1:=Copy(targ1,2,30);
  2359.       yy:=pos('''',targ1);
  2360.       if yy>0 then begin
  2361.         targ1:=Copy(targ1,1,yy-1);
  2362.       End;
  2363.     End;
  2364.     if argcnt=0 then begin
  2365.       orgstr:=upto+has0arg+after;
  2366.     End Else
  2367.     if argcnt=1 then begin
  2368.       if pin('SKIP',upper(srchfor)) then begin
  2369.         if (pin('''',orgstr)) then begin
  2370.           orgstr:=upto+targ1+'.Skip'+after;
  2371.         End Else
  2372.           Begin
  2373.           orgstr:=upto+'dbf.Skip2('+targ1+')'+after;
  2374.         End;
  2375.       End Else
  2376.         Begin
  2377.         if noparm1 then begin
  2378.           orgstr:=upto+targ1+afterdot+after;
  2379.         End Else
  2380.           Begin
  2381.           orgstr:=upto+'dbf'+afterdot+'('+targ1+')'+after;
  2382.         End;
  2383.       End;
  2384.     End Else
  2385.     if argcnt=2 then begin
  2386.       orgstr:=upto+has2arg+'('+targ2+')'+after;
  2387.     End;
  2388.     starts:=pos(srchfor,orgstr);
  2389.   End;
  2390.   Result:=orgstr;
  2391. end;
  2392.  
  2393. End.
  2394.